Makefile.def, [...]: Remove all mention of libf2c.

top:
	* Makefile.def, Makefile.tpl, configure.in: Remove all mention
	of libf2c.
	* configure, Makefile.in: Regenerate.
contrib:
	* gcc_update: Remove gcc/f/intdoc.texi and all libf2c files
	from list of files to be touched.
	* convert_to_f2c, convert_to_g2c, download_f2c: Delete.
gcc:
	* f: Entire directory removed

	* c-common.h (CTI_G77_INTEGER_TYPE, CTI_G77_UINTEGER_TYPE)
	(CTI_G77_LONGINT_TYPE, CTI_G77_ULONGINT_TYPE)
	(g77_integer_type_node, g77_uinteger_type_node)
	(g77_longint_type_node, or g77_ulongint_type_node): Delete.
	* c-common.c (c_common_nodes_and_builtins): Do not initialize
	the above set of variables.

	* config/i386/uwin.h: No need to define WIN32_UWIN_TARGET.
	* doc/invoke.texi, doc/standards.texi: Remove cross-references
	to g77 manual.
gcc/po:
	* exgettext (spec_error_string): Do not scan beyond the end of
	the string for a close brace.  Do not bail out at the first
	incidence of %%e.
	* gcc.pot: Regenerate.

From-SVN: r81967

109 files changed, 0 insertions, 162994 deletions

diff --git a/gcc/f/ChangeLog b/gcc/f/ChangeLog
deleted file mode 100644
index 0d3532e..0000000
--- a/gcc/f/ChangeLog
+++ /dev/null
@@ -1,7304 +0,0 @@
-2004-05-13  Diego Novillo  <dnovillo@redhat.com>
-
-	Merge from tree-ssa-20020619-branch.
-
-	* config-lang.in (build_by_default): Set to no.
-
-2004-04-18  Gerald Pfeifer  <gerald@pfeifer.com>
-
-	* g77.texi (Floating-point Errors): Avoid referencing 
-	http://www.linuxsupportline.com/~billm/ which as has been hijacked.
-
-2004-04-02  Jan Hubicka  <jh@suse.cz>
-
-	* Make-lang.in (com.o): Add dependnecy on function.h
-	* com.c: Include function.h
-	(finish_function): Clear DECL_STRUCT_FUNCTION.
-
-2004-04-01  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
-
-	* com.c (ffe_truthvalue_conversion, case COMPONENT_REF):
-	Use DECL_UNSIGNED and integer_onep.
-
-2004-03-31  Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>
-
-	* com.c (ffecom_arrayref_): Use TYPE_UNSIGNED, not TREE_UNSIGNED.
-	(ffecom_expr_): Likewise.
-
-2004-03-30  Zack Weinberg  <zack@codesourcery.com>
-
-	* com.c: Use new shorter form of GTY markers.
-
-2004-03-21  Joseph S. Myers  <jsm@polyomino.org.uk>
-
-	* g77.texi: Update link to "G++ and GCC".
-
-2004-03-21  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-02-29  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-19  Matt Kraai  <kraai@alumni.cmu.edu>
-
-	* Make-lang.in (f/stamp-1t, f/stamp-2t, f/stamp-fo)
-	(f/stamp-io, f/stamp-nq, f/stamp-op, f/stamp-ot): Use the top
-	level move-if-change.
-
-2004-02-15  Roger Sayle  <roger@eyesopen.com>
-
-	* lex.c (ffelex_get_directive_line): Provide a more descriptive
-	comment.  Remove reference to non-existant get_directive_line.
-
-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-02-03  Kazu Hirata  <kazu@cs.umass.edu>
-
-	* com.c (ffecom_member_phase2_): Use gen_rtx_MEM instead of
-	gen_rtx.
-
-2004-01-30  Kelley Cook  <kcook@gcc.gnu.org>
-
-	* Make-lang.in (doc/g77.dvi): Use $(abs_docdir).
-
-2004-01-28  Ian Lance Taylor  <ian@wasabisystems.com>
-
-	* Make-lang.in (f/str-*.h, f/str-*.j): Use stamp files and
-	move-if-change to avoid changing these files unnecessarily.
-
-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-20  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>
-
-	PR Fortran/11301
-	* com.c (ffecom_sym_transform_): finish_decl should have
-	the same last argument as start_decl.
-
-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.
-
-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>
-
-	PR Fortran/11301
-	* com.c (ffecom_sym_transform_): Only install
-	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.
-
-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>
-
-	* intdoc.in: Fix documentation of IDATE.
-	* intdoc.texi: Regenerate.
-	* 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 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  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.
-
-2003-05-12  Zack Weinberg  <zack@codesourcery.com>
-
-	* bad.c: Don't call diagnostic_count_diagnostic.
-
-2003-05-12  Roger Sayle  <roger@eyesopen.com>
-
-	* 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".
-
-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>
-
-	PR Fortran/9263
-	* gcc/f/data.c (ffedata_advance_): Check initial, final and
-	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
-	* target.h (ffetarget_divide_integer1): Perform division by -1
-	using negation to prevent possible overflow trap on the host.
-
-2003-03-25  Marcelo Abreu  <mmabreu@inf.ufrgs.br>
-
-	PR fortran/10204
-	* ffe.texi: Reference the GCC web site in the URL.
-
-2003-03-24  Toon Moene  <toon@moene.indiv.nluug.nl>
-
-	PR fortran/10197
-	* news.texi: Document PR fortran/10197 fixed.
-
-Sun Mar 23 23:43:45 2003  Mark Mitchell  <mark@codesourcery.com>
-
-	PR c++/7086
-	* com.c (ffecom_sym_transform_): Adjust calls to
-	put_var_into_stack.
-	(ffe_mark_addressable): Likewise.
-
-2003-03-22  Bud Davis  <bdavis9659@comcast.net>
-
-	* com.c (ffecom_constantunion_with_type): New function.
-	* com.h (ffecom_constantunion_with_type): Declare.
-	* stc.c (ffestc_R810): Check for kind type.
-	* 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-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.
-
-2003-02-04  Joseph S. Myers  <jsm@polyomino.org.uk>
-
-	* g77.texi, invoke.texi: Update to GFDL 1.2.
-
-2003-01-31  Toon Moene  <toon@moene.indiv.nluug.nl>
-
-	* news.texi: Document fixing PR fortran/7681
-	and optimization/9258.
-
-2003-01-26  Toon Moene  <toon@moene.indiv.nluug.nl>
-
-	* lang-specs.h: Revoke change to (incorrectly) prohibit
-	passing -f options to cc1 when preprocessing.
-	* news.texi: Document this.
-
-Tue Jan 21 08:42:12 2003  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
-
-	Make-lang.in (f/sta.o-warn): Add -Wno-error.
-
-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  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: Remove -f options before preprocessing.
-	* news.texi: Document fixing of PR Fortran/9038.
-
-2003-01-03  Bud Davis <bdavis11@directvinternet.com>
-
-	* stc.c (ffestc_R810): Allow any kind integer in
-	case statements.
-	* ste.c (ffeste_R810): Give error message when
-	case selector exceeds its valid values.
-
-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
-	* 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
-	* 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:
diff --git a/gcc/f/ChangeLog.0 b/gcc/f/ChangeLog.0
deleted file mode 100644
index 3d6675e..0000000
--- a/gcc/f/ChangeLog.0
+++ /dev/null
@@ -1,4806 +0,0 @@
-Mon Jun 29 09:47:33 1998  Craig Burley  <burley@gnu.org>
-
-	Fix 980628-*.f:
-	* bld.h: New `pad' field and accessor macros for
-	ACCTER, ARRTER, and CONTER ops.
-	* bld.c (ffebld_new_accter, ffebld_new_arrter,
-	ffebld_new_conter_with_orig): Initialize `pad' field
-	to zero.
-	* com.c (ffecom_transform_common_): Include initial
-	padding (aka modulo aka offset) in size calculation.
-	Copy initial padding value into FFE initialization expression
-	so the GBE transformation of that expression includes it.
-	Make array low bound 0 instead of 1, for consistency.
-	(ffecom_transform_equiv_): Include initial
-	padding (aka modulo aka offset) in size calculation.
-	Copy initial padding value into FFE initialization expression
-	so the GBE transformation of that expression includes it.
-	Make array low bound 0 instead of 1, for consistency.
-	(ffecom_expr_, case FFEBLD_opACCTER): Delete unused `size'
-	variable.
-	Track destination offset separately, allowing for
-	initial padding.
-	Don't bother setting initial PURPOSE offset if zero.
-	Include initial padding in size calculation.
-	(ffecom_expr_, case FFEBLD_opARRTER): Allow for
-	initial padding.
-	Include initial padding in size calculation.
-	Make array low bound 0 instead of 1, for consistency.
-	(ffecom_finish_global_): Make array low bound 0 instead
-	of 1, for consistency.
-	(ffecom_notify_init_storage): Copy `pad' field from old
-	ACCTER to new ARRTER.
-	(ffecom_notify_init_symbol): Ditto.
-	* data.c (ffedata_gather_): Initialize `pad' field in new
-	ARRTER to 0.
-	(ffedata_value_): Ditto.
-	* equiv.c (ffeequiv_layout_local_): When lowering start
-	of equiv area, extend lowering to maintain needed alignment.
-	* target.c (ffetarget_align): Handle negative offset correctly.
-
-	* global.c (ffeglobal_pad_common): Warn about nonzero
-	padding only the first time its seen.
-	If new padding larger than old, update old.
-	(ffeglobal_save_common): Use correct type for size throughout.
-	* global.h: Use correct type for size throughout.
-	(ffeglobal_common_pad): New macro.
-	(ffeglobal_pad): Delete this unused and broken macro.
-
-Sat Jun 27 12:18:33 1998  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in (g77): Depend on mkstemp.o.  Link in mkstemp.o.
-
-Fri Jun 26 11:54:19 1998  Craig Burley  <burley@gnu.org>
-
-	* g77spec.c (lang_specific_driver): Put `-lg2c' in
-	front of any `-lm' that is seen.
-
-Wed Jun 24 01:01:23 1998  Jeffrey A Law  (law@cygnus.com)
-
-	* g77spec.c (lang_specific_driver): Revert last change.
-
-Mon Jun 22 23:12:05 1998  H.J. Lu  (hjl@gnu.org)
-
-	* Make-lang.in (G77STAGESTUFF): Add g77.c.
-
-Fri Jun 19 07:54:40 1998  H.J. Lu  (hjl@gnu.org)
-
-	* g77spec.c (lang_specific_driver): Check n_infiles before
-	appending args.
-
-Mon Jun 15 23:39:24 1998  Craig Burley  <burley@gnu.org>
-
-	* Make-lang.in (f/g77.info): Use -f when removing
-	pre-existing Info files, if any.  (This rm command
-	can go away once makeinfo has been changed to delete
-	.info-N files beyond the last one it creates.)
-
-	* Make-lang.in ($(srcdir)/f/intdoc.texi): Compile
-	using $(INCLUDES) macro to get the new hconfig.h
-	and system.h headers.
-
-Mon Jun 15 22:21:57 1998  Craig Burley  <burley@gnu.org>
-
-	Cutover to system.h:
-	* Make-lang.in:
-	* Makefile.in:
-	* ansify.c:
-	* bad.c:
-	* bld.c:
-	* com.c:
-	* com.h:
-	* expr.c:
-	* fini.c:
-	* g77spec.c:
-	* implic.c:
-	* intdoc.c:
-	* intrin.c:
-	* lex.c:
-	* lex.h:
-	* parse.c:
-	* proj.c:
-	* proj.h:
-	* src.c:
-	* src.h:
-	* stb.c:
-	* ste.c:
-	* target.c:
-	* top.c:
-	* system.j: New file.
-
-	Use toplev.h where appropriate:
-	* Make-lang.in:
-	* Makefile.in:
-	* bad.c:
-	* bld.c:
-	* com.c:
-	* lex.c:
-	* ste.c:
-	* top.c:
-	* toplev.j: New file.
-
-	Conditionalize all dumping/reporting routines so they don't
-	get built for gcc/egcs:
-	* bld.c:
-	* bld.h:
-	* com.c:
-	* equiv.c:
-	* equiv.h:
-	* sta.c:
-	* stt.c:
-	* stt.h:
-	* symbol.c:
-	* symbol.h:
-
-	Use hconfig.h instead of config.h where appropriate:
-	* Makefile.in (proj-h.o): Compile with -DUSE_HCONFIG.
-	* fini.c: Define USE_HCONFIG before including proj.h.
-
-	* Makefile.in (deps-kinda): Redirect stderr to stdout,
-	to eliminate diagnostics vis-a-vis g77spec.c.
-
-	* Makefile.in: Regenerate dependencies via deps-kinda.
-
-	* lex.c (ffelex_file_fixed, ffelex_file_free): Eliminate
-	apparently spurious warnings about uninitialized variables
-	`c', `column', and so on.
-
-Sat Jun 13 03:13:18 1998  Craig Burley  <burley@gnu.org>
-
-	* g77spec.c (lang_specific_driver): Print out egcs
-	version info first, to be compatible with what some
-	test facilities expect.
-
-Wed Jun 10 13:17:32 1998  Dave Brolley  <brolley@cygnus.com>
-
-	* top.h (ffe_decode_option): New argc/argv interface.
-	* top.c (ffe_decode_option): New argc/argv interface.
-	* parse.c (yyparse): New argc/argv interface for ffe_decode_option.
-	* com.c (lang_decode_option): New argc/argv interface.
-
-Sun Jun  7 14:04:34 1998  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (lang_init_options): New function.
-	* top.c (ffe_decode_option): Remove all trace of -fset-g77-defaults.
-	Set ffe_is_do_internal_checks_ with -version.
-	* lang-options.h: Likewise.
-	* lang-specs.h: Likewise.
-
-Fri Jun  5 15:53:17 1998  Per Bothner  <bothner@cygnus.com>
-
-	* g77spec.c (lang_specific_pre_link, lang_specific_extra_ofiles):
-	Define - update needed by gcc.c change.
-
-Mon Jun  1 19:37:42 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_init_0): Fix setup of INTEGER(KIND=7)
-	pointer type.
-	* info.c (ffeinfo_type): Don't crash on null type.
-	* expr.c (ffeexpr_fulfill_call_): Don't special-case
-	%LOC(expr) or LOC(expr).
-	Delete FFEGLOBAL_argsummaryPTR.
-	* global.c, global.h: Delete FFEGLOBAL_argsummaryPTR.
-
-Thu May 28 21:32:18 1998  Craig Burley  <burley@gnu.org>
-
-	Restore circa-0.5.22 capabilities of `g77' driver:
-	* Make-lang.in (g77spec.o): Depend on f/version.h.
-	(g77version.o): New rule to compile g77 version info.
-	(g77$(exeext)): Depend on and link in g77version.o.
-	* g77spec.c: Rewrite to be more like 0.5.22 version
-	of g77.c, making filtering of command line smarter
-	so mixed Fortran and C (etc.) can be compiled, verbose
-	version info can be obtained, etc.
-	* lang-specs.h (f77-version): New "language" to support
-	"g77 -v" command under new gcc 2.8 regime.
-	* lex.c (ffelex_file_fixed): If -fnull-version, just
-	substitute a "source file" that prints out version info.
-	* top.c, top.h: Support -fnull-version.
-
-	* lang-specs.h: Use "%O" instead of OO macro to specify
-	object extension.  Remove old stringizing cruft.
-
-	* Make-lang.in (g77.c, g77spec.o, g77.o, g77$(exeext),
-	g77-cross$(exeext), f771,
-	$(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi,
-	$(srcdir)/f/intdoc.texi,
-	f77.install-common, f77.install-info, f77.install-man,
-	f77.uninstall, $(G77STAGESTUFF), f77.stage1, f77.stage2,
-	f77.stage3, f77.stage4, f77.distdir): Don't do anything
-	unless user specified "f77" or "F77" in $LANGUAGES either
-	during configuration or explicitly.  For convenience of
-	various tests and to work around lack of the assignment
-	"LANGUAGES=$(BOOT_LANGUAGES)" in the "make stage1" command
-	of "make bootstrap" in gcc, use a touch file named "lang-f77"
-	to communicate whether this is the case.
-
-	* Make-lang.in (F77_FLAGS_TO_PASS): Delete this macro,
-	replace with minimal expansion of its former self in
-	each of the two instances where it was used.
-
-	* Makefile.in (HOST_CC): Delete this definition.
-
-	* com.c (index, rindex): Delete these declarations.
-
-	* proj.h: (isascii): Delete this.
-
-	* Make-lang.in (f77.install-common): Warn if `f77-install-ok'
-	flag-file exists, since it no longer triggers any activity.
-
-	Rename libf2c.a and f2c.h to libg2c.a and g2c.h,
-	normalize and simplify g77/libg2c build process:
-	* Make-lang.in: Remove all support for overwriting
-	/usr/bin/f77 etc., or whatever the actual names are
-	via $(prefix) and $(local_prefix).  (g++ overwrites
-	/usr/bin/c++, but then it's often the only C++ compiler
-	on the system; f77 often exists on systems that are
-	installing g77.)
-	(f77.realclean): Remove obsolete target.
-	(g77.c, g77$(exeext)): Minor changes to look more like g++'s
-	stuff.
-	(f771): Now built with srcdir=gcc/f, not srcdir=gcc, to be
-	more like g++ and such.
-	(f/Makefile): Removed, as g++ doesn't need this rule.
-	(f77.install-common): No longer install f77, etc.
-	(f77.install-man): No longer install f77.1.
-	(f77.uninstall): No longer uninstall f77, f77.1, etc.
-	(f77.stage1, f77.stage2, f77.stage3, f77.stage4): Do work
-	only if "f77" appears in $(LANGUAGES).
-	(Note: gcc's Makefile.in's bootstrap target should set
-	LANGUAGES=$(BOOT_LANGUAGES) when making the stage1 target.)
-	* Makefile.in: Update vis-a-vis gcc/cp/Makefile.in.
-	(none): Remove.
-	(g77-only): Relocate.
-	(all.indirect, f771, *.o): Now assumes current directory
-	is this dir (gcc/f), not the parent directory.
-	(TAGS): Remove "echo 'parse.y,0'  >> TAGS ;" line.
-	* config-lang.in: Delete commented-out code.
-	Fix stagestuff definition.  Add more stuff to
-	diff_excludes definition.  Don't create any directories.
-	Set outputs to f/Makefile, to get variable substition
-	to happen (what does that really do, anyway?!).
-	* g77spec.c: Rename libf2c to libg2c.
-
-	* com.h: Remove all of the gcc back-end decls,
-	since egcs should have all of them correct.
-
-	* com.c: Include "proj.h" before anything else,
-	as that's how things are supposed to work.
-	* ste.c: Ditto.
-
-	* bad.c: Include "flags.j" here, since some diagnostics
-	check flag_pedantic_errors.
-
-	* Makefile.in (f/*.o): Rebuild dependencies via
-	deps-kinda.
-
-	* output.j: New source file.
-	* Make-lang.in (F77_SRCS): Update accordingly.
-	* Makefile.in (OUTPUT_H): Ditto.
-	(deps-kinda): Ditto.
-	* com.c: Include "output.j" here.
-	* lex.c: Ditto.
-
-Mon May 25 03:34:42 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_expr_): Fix D**I and Z**I cases to
-	not convert (DOUBLE PRECISION) D and (DOUBLE COMPLEX) Z
-	to INTEGER.  (This is dead code here anyway.)
-
-Sat May 23 06:32:52 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_finish_symbol_transform_): Don't transform
-	statement (nested) functions, to avoid gcc compiling them
-	and thus producing linker errors if they refer to undefined
-	external functions.  But warn if they're unused and -Wunused.
-	* bad.def (FFEBAD_SFUNC_UNUSED): New diagnostic.
-
-Wed May 20 12:12:55 1998  Craig Burley  <burley@gnu.org>
-
-	* Version 0.5.23 released.
-
-Tue May 19 14:52:41 1998  Craig Burley  <burley@gnu.org>
-
-	* bad.def (FFEBAD_OPEN_UNSUPPORTED, FFEBAD_INQUIRE_UNSUPPORTED,
-	FFEBAD_READ_UNSUPPORTED, FFEBAD_WRITE_UNSUPPORTED,
-	FFEBAD_QUAD_UNSUPPORTED, FFEBAD_BLOCKDATA_STMT,
-	FFEBAD_TRUNCATING_CHARACTER, FFEBAD_TRUNCATING_HOLLERITH,
-	FFEBAD_TRUNCATING_NUMERIC, FFEBAD_TRUNCATING_TYPELESS,
-	FFEBAD_TYPELESS_OVERFLOW): Change these from warnings
-	to errors.
-
-Tue May 19 14:51:59 1998  Craig Burley  <burley@gnu.org>
-
-	* Make-lang.in (f77.install-info, f77.uninstall):
-	Use install-info as appropriate.
-
-Tue May 19 12:56:54 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_init_0): Rename xargc to f__xargc,
-	in accord with same-dated change to f/runtime.
-
-Fri May 15 10:52:49 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_convert_narrow_, ffecom_convert_widen_):
-	Be even more persnickety in checking for internal bugs.
-	Also, if precision isn't changing, just return the expr.
-
-	* expr.c (ffeexpr_token_number_): Call
-	ffeexpr_make_float_const_ to make an integer.
-	(ffeexpr_make_float_const_): Handle making an integer.
-
-	* intrin.c (ffeintrin_init_0): Distinguish between
-	crashes on bad arg base and kind types.
-
-Fri May 15 01:44:22 1998  Mumit Khan <khan@xraylith.wisc.edu>
-
-	* Make-lang.in (f77.mostlyclean): Add missing exeext.
-
-Thu May 14 13:30:59 1998  Craig Burley  <burley@gnu.org>
-
-	* Make-lang.in (f/expr.c): Now depends on f/stamp-str.
-	* expr.c: Use ffestrOther in place of ffeexprDotdot_.
-	* str-ot.fin: Add more keywords for expr.c.
-
-	* intdoc.c (dumpimp): Trivial fix.
-
-	* com.c (ffecom_expr_): Add ltkt variable for clarity.
-
-Wed May 13 13:05:34 1998  Craig Burley  <burley@gnu.org>
-
-	* Make-lang.in (G77STAGESTUFF): Add g77.o, g77spec.o,
-	and g77version.o.
-	(f77.clean): Add removal of g77.c, g77.o, g77spec.o,
-	and g77version.o.
-	(f77.distclean): Delete removal of g77.c.
-
-Thu Apr 30 18:59:43 1998  Jim Wilson  <wilson@cygnus.com>
-
-	* Make-lang.in (g77.info, g77.dvi, BUGS, INSTALL, NEWS): Put -o
-	option before input file.
-
-Tue Apr 28 09:23:10 1998  Craig Burley  <burley@gnu.org>
-
-	Fix 980427-0.f:
-	* global.c (ffeglobal_ref_progunit_): When transitioning
-	from EXT to FUNC, discard hook, since the decl, if any, is
-	probably wrong.
-
-Sun Apr 26 09:05:50 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_char_enhance_arg_): Wrap the upper bound
-	(the PARM_DECL specifying the length of the CHARACTER*(*)
-	dummy arg) in a variable_size invocation, to prevent
-	dwarf2out.c crashing when compiling code with -g.
-
-Sat Apr 18 15:26:57 1998  Jim Wilson  <wilson@cygnus.com>
-
-	* g77spec.c (lang_specific_driver): New argument in_added_libraries.
-	New local added_libraries.  Increment count when add library to
-	arglist.
-
-Sat Apr 18 05:03:21 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_check_size_overflow_): Ignore overflow
-	as well if dummy argument.
-
-Fri Apr 17 17:18:04 1998  Craig Burley  <burley@gnu.org>
-
-	* version.h: Get rid of the overly large headers
-	here too, as done in version.c.
-
-Tue Apr 14 15:51:37 1998  Dave Brolley  <brolley@cygnus.com>
-
-	* com.c (init_parse): Now returns char* containing filename;
-
-Tue Apr 14 14:40:40 1998  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_start_progunit_): Mark function decl
-	as used, to avoid spurious warning (-Wunused) for ENTRY.
-
-Tue Apr 14 14:19:34 1998  Craig Burley  <burley@gnu.org>
-
-	* sta.c (ffesta_second_): Check for CASE DEFAULT
-	as well as CASE, or it won't be recognized.
-
-Thu Apr  9 00:18:44 1998  Dave Brolley  (brolley@cygnus.com)
-
-	* com.c (finput): New variable.
-	(init_parse): Handle !USE_CPPLIB.
-	(finish_parse): New function.
-	(lang_init): No longer declare finput.
-
-Sat Apr  4 17:45:01 1998  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (ffecom_expr_): Revert Oct 22 change.  Instead take a WIDENP
-	argument so that we can respect the signedness of the original type.
-	(ffecom_init_0): Do sizetype initialization first.
-
-1998-03-28  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (f771$(exeext)): Fix typo.
-
-1998-03-24  Martin von Loewis  <loewis@informatik.hu-berlin.de>
-
-	* com.c (lang_print_xnode): New function.
-
-Mon Mar 23 21:20:35 1998  Craig Burley  <burley@gnu.org>
-
-	* version.c: Reduce to a one-line file, like
-	gcc's version.c, since there's really no content
-	there.
-
-Mon Mar 23 11:58:43 1998  Craig Burley  <burley@gnu.org>
-
-	* bugs.texi: Various updates.
-
-	* com.c (ffecom_tree_canonize_ptr_): Fix up spacing a bit.
-
-Sun Mar 22 00:50:42 1998  Nick Clifton  <nickc@cygnus.com>
-                          Geoff Noer    <noer@cygnus.com>
-
-	* Makefile.in: Various fixes for building cygwin32 native toolchains.
-	* Make-lang.in: Likewise.
-
-Mon Mar 16 21:20:35 1998  Craig Burley  <burley@gnu.org>
-
-	* expr.c (ffeexpr_sym_impdoitem_): Don't blindly
-	reset symbol info after calling ffesymbol_error,
-	to avoid crash.
-
-Mon Mar 16 15:38:50 1998  Craig Burley  <burley@gnu.org>
-
-	* Version 0.5.22 released.
-
-Mon Mar 16 14:36:02 1998  Craig Burley  <burley@gnu.org>
-
-	Make -g work better for ENTRY:
-	* com.c (ffecom_start_progunit_): Master function
-	for ENTRY-laden procedure is not really invented,
-	so it can be debugged.
-	(ffecom_do_entry_): Push/set/pop lineno for each
-	entry point.
-
-Sun Mar 15 05:48:49 1998  Craig Burley  <burley@gnu.org>
-
-	* intrin.def: Fix spelling of mixed-case form
-	of `CPU_Time' (was `Cpu_Time').
-
-Thu Mar 12 13:50:21 1998  Craig Burley  <burley@gnu.org>
-
-	* lang-options.h: Sort all -f*-intrinsics-* options,
-	for consistency with other g77 versions.
-
-Thu Mar 12 09:39:40 1998  Manfred Hollstein  <manfred@s-direktnet.de>
-
-	* lang-specs.h: Properly put brackets around array elements in initializer.
-
-1998-03-09  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in: Set CONFIG_SITE to a non-existent file since
-	/dev/null loses with bash 2.0/autoconf 2.12.  Put
-	F77_FLAGS_TO_PASS before CC.
-
-Sun Mar  8 16:35:34 1998  Craig Burley  <burley@gnu.org>
-
-	* intrin.def: Use tabs instead of blanks more
-	consistently (excepting DEFGEN section for now).
-
-Wed Mar  4 17:38:21 1998  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in: Remove more references to libf77.
-
-Tue Mar  3 10:52:35 1998  Manfred Hollstein  <manfred@s-direktnet.de>
-
-	* g77.texi: Use @url for citing URLs.
-
-Sat Feb 28 15:24:38 1998  Craig Burley  <burley@gnu.org>
-
-	* intrin.def: Make CPU_TIME's arg generic real to be just
-	like SECOND_subr.
-
-Fri Feb 20 12:45:53 1998  Craig Burley  <burley@gnu.org>
-
-	* expr.c (ffeexpr_token_arguments_): Make sure
-	outer exprstack isn't null.
-
-1998-02-16  Dave Love  <d.love@dl.ac.uk>
-
-	* Makefile.in (f/fini): Don't use -W -Wall with HOST_CC.
-
-Fri Feb 13 00:14:56 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
-
-	* com.c (type_for_mode): Add explicit braces to avoid ambiguous `else'.
-
-	* expr.c (ffeexpr_type_combine): Likewise.
-	(ffeexpr_reduce_): Likewise.
-	(ffeexpr_declare_parenthesized_): Likewise.
-
-	* src.c (ffesrc_strcmp_1ns2i): Likewise.
-	(ffesrc_strcmp_2c): Likewise.
-	(ffesrc_strncmp_2c): Likewise.
-
-	* stb.c (ffestb_halt1_): Likewise.
-	(ffestb_R90910_): Likewise.
-	(ffestb_R9109_): Likewise.
-
-	* stc.c (ffestc_R544_equiv_): Likewise.
-
-	* std.c (ffestd_subr_copy_easy_): Likewise.
-	(ffestd_R1001dump_): Likewise.
-	(ffestd_R1001dump_1005_1_): Likewise.
-	(ffestd_R1001dump_1005_2_): Likewise.
-	(ffestd_R1001dump_1005_3_): Likewise.
-	(ffestd_R1001dump_1005_4_): Likewise.
-	(ffestd_R1001dump_1005_5_): Likewise.
-	(ffestd_R1001dump_1010_2_): Likewise.
-
-	* ste.c (ffeste_R840): Likewise.
-
-	* sts.c (ffests_puttext): Likewise.
-
-	* symbol.c (ffesymbol_check_token_): Likewise.
-
-	* target.c (ffetarget_real1): Likewise.
-	(ffetarget_real2): Likewise.
-
-Wed Feb 11 01:44:48 1998  Richard Henderson  (rth@cygnus.com)
-
-	* com.c (ffecom_ptr_to_expr) [FFEBLD_opARRAYREF]:  Do upper - lower
-	in the native type, so as to properly handle negative indices.
-
-Tue Feb  3 20:13:05 1998  Richard Henderson  <rth@cygnus.com>
-
-	* config-lang.in: Remove references to runtime/.
-
-Sun Feb  1 12:43:49 1998  J"orn Rennecke <amylaar@cygnus.co.uk>
-
-	* com.c (ffecom_tree_canonize_ptr_): Place bitsizetype typed expr
-	as first agument in MULT_EXPR.
-	Use bitsize_int (0L, 0L) as zero for bitsizes.
-	(ffecom_tree_canonize_ref_):
-	Use bitsize_int (0L, 0L) as zero for bitsizes.
-	(ffecom_init_0): Use set_sizetype.
-
-Sun Feb  1 02:26:58 1998  Richard Henderson  <rth@cygnus.com>
-
-	* runtime directory -- moved into "libf2c" in the toplevel
-	directory.
-	* Make-lang.in: Remove all runtime related stuff.
-
-Sun Jan 25 12:32:15 1998  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
-
-	* Make-lang.in (f77.stage1): Depend on stage1-start so parallel
- 	make works better.
-	* (f77.stage2): Likewise for stage2-start.
-	* (f77.stage3): Likewise for stage3-start.
-	* (f77.stage4): Likewise for stage4-start.
-
-Sat Jan 17 21:28:08 1998  Pieter Nagel <pnagel@epiuse.co.za>
-
-	* Makefile.in (FLAGS_TO_PASS): Pass down gcc_include_dir and
-	local_prefix to sub-make invocations.
-
-Tue Jan 13 22:07:54 1998  Jeffrey A Law  (law@cygnus.com)
-
-	* lang-options.h: Add missing options.
-
-Sun Jan 11 02:14:47 1998  Craig Burley  <burley@gnu.org>
-
-	Support FORMAT(I<1+2>) (constant variable-FORMAT
-	expressions):
-	* bad.def (FFEBAD_FORMAT_VARIABLE): New diagnostic.
-	* std.c (ffestd_R1001rtexpr_): New function.
-	(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_):
-	Use new function instead of ffestd_R1001error_.
-
-	* stb.c (ffestb_R10014_, ffestb_R10016_, ffestb_R10018_,
-	ffestb_R100110_): Restructure `for' loop for style.
-
-	Fix 970626-2.f by not doing most back-end processing
-	when current_function_decl is an ERROR_MARK, and by
-	making that the case when its type would be an ERROR_MARK:
-	* com.c (ffecom_start_progunit_, finish_function,
-	lang_printable_name, start_function,
-	ffecom_finish_symbol_transform_): Test for ERROR_MARK.
-	* std.c (ffestd_stmt_pass_): Don't do any downstream
-	processing if ERROR_MARK.
-
-	* Make-lang.in (f77.install-common): Don't install, and
-	don't uninstall existing, Info files if f/g77.info
-	doesn't exit.  (This is a somewhat modified version
-	of an egcs patch on 1998-01-07 12:05:51 by Bruno Haible
-	<bruno@linuix.mathematik.uni-karlsruhe.de>.)
-
-Fri Jan  9 19:09:07 1998  Craig Burley  <burley@gnu.org>
-
-	Fix -fpedantic combined with `F()' invocation,
-	also -fugly-comma combined with `IARGC()' invocation:
-	* bad.def (FFEBAD_NULL_ARGUMENT_W): New diagnostic.
-	* expr.c (ffeexpr_finished_): Don't reject null expressions
-	in the argument-expression context -- let outer context
-	handle that.
-	(ffeexpr_token_arguments_): Warn about null expressions
-	here if -fpedantic (as appropriate).
-	Obey -fugly-comma for only external-procedure invocations.
-	* intrin.c (ffeintrin_check_): No longer ignore explicit
-	omitted trailing args.
-
-Tue Dec 23 14:58:04 1997  Craig Burley  <burley@gnu.org>
-
-	* intrin.c (ffeintrin_fulfill_generic): Don't generate
-	FFEBAD_INTRINSIC_TYPE for CHARACTER*(*) intrinsic.
-
-	* com.c (ffecom_gfrt_basictype):
-	(ffecom_gfrt_kindtype):
-	(ffecom_make_gfrt_):
-	(FFECOM_rttypeVOIDSTAR_): New return type `void *', for
-	the SIGNAL intrinsic.
-	* com-rt.def (FFECOM_rttypeSIGNAL): Now returns `void *'.
-	* intdoc.c: Replace `p' kind specifier with `7'.
-	* intrin.c (ffeintrin_check_, ffeintrin_init_0): Replace
-	`p' kind specifier with `7'.
-	* intrin.def (FFEINTRIN_impLOC, FFEINTRIN_impSIGNAL_func,
-	FFEINTRIN_impSIGNAL_subr): Replace `p' specifier with `7'.
-	Also, SIGNAL now returns a `void *' status, not `int'.
-
-	Improve run-time diagnostic for "PRINT '(I1', 42":
-	* com.c (ffecom_char_args_x_): Renamed from ffecom_char_args_,
-	which is now a macro (to avoid lots of changes to other code)
-	with new arg, ffecom_char_args_with_null_ being another new
-	macro to call same function with different value for new arg.
-	This function now appends a null byte to opCONTER expression
-	if the new arg is TRUE.
-	(ffecom_arg_ptr_to_expr): Support NULL length pointer.
-	* ste.c (ffeste_io_cilist_):
-	(ffeste_io_icilist_): Pass NULL length ptr for
-	FORMAT expression, so null byte gets appended where
-	feasible.
-	* target.c (ffetarget_character1):
-	(ffetarget_concatenate_character1):
-	(ffetarget_substr_character1):
-	(ffetarget_convert_character1_character1):
-	(ffetarget_convert_character1_hollerith):
-	(ffetarget_convert_character1_integer4):
-	(ffetarget_convert_character1_logical4):
-	(ffetarget_convert_character1_typeless):
-	(ffetarget_hollerith): Append extra phantom null byte as
-	part of FFETARGET-NULL-BYTE kludge.
-
-	* intrin.def (FFEINTRIN_impCPU_TIME): Point to
-	FFECOM_gfrtSECOND as primary run-time routine.
-
-Mon Dec 22 12:41:07 1997  Craig Burley  <burley@gnu.org>
-
-	* intrin.c (ffeintrin_init_0): Remove duplicate
-	check for `!'.
-
-Fri Dec 19 00:12:01 1997  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (ffecom_sym_transform_): Assumed arrays have no upper bound.
-
-Mon Dec 15 17:35:35 1997  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'.
-
-Sun Dec 14 02:49:58 1997  Craig Burley  <burley@gnu.org>
-
-	* intrin.c (ffeintrin_init_0): Fix up indentation a bit.
-	Fix bug that prevented checking of arguments other
-	than the first.
-
-	* intdoc.c: Fix up indentation a bit.
-
-Tue Dec  9 16:20:57 1997  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (ffecom_type_vardesc_): Vardesc.dims is a `ftnlen*'.
-
-Tue Dec  2 09:57:16 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in (f77.clean): Remove g77.c.
-
-Mon Dec  1 19:12:36 1997  Craig Burley  <burley@gnu.org>
-
-	* intrin.c (ffeintrin_check_): Fix up indentation a bit more.
-
-Mon Dec  1 16:21:08 1997  Craig Burley  <burley@gnu.org>
-
-	* com.c (ffecom_arglist_expr_): Crash if non-supplied
-	optional arg isn't passed as an address.
-	Pass null pointer explicitly, instead of via ffecom routine.
-	If incoming argstring is NULL, substitute pointer to "0".
-	Recognize '0' as ending the usual arg stuff, just like '\0'.
-
-Sun Nov 30 22:22:22 1997  Craig Burley  <burley@gnu.org>
-
-	* intdoc.c: Minor fix-ups.
-
-	* intrin.c (ffeintrin_check_): Fix up indentation a bit.
-
-	* intrin.def: Fix up spacing a bit.
-
-Tue Nov 25 15:33:28 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in (f77.all.build): Add $(exeext) to binary files.
-	(f77.all.cross, f77.start.encap): Simliarly.
-
-Fri Nov 21 09:35:20 1997  Fred Fish  <fnf@cygnus.com>
-
-	* Make-lang.in (stmp-f2c.h): Move inclusion of F77_FLAGS_TO_PASS
-	to before override of CC so that the override works.
-
-Thu Nov 20 00:58:14 1997  H.J. Lu  (hjl@gnu.ai.mit.edu)
-
-	* Make-lang.in (f77.install-info): Depend on f77.info.
-
-1997-11-17  Dave Love  <d.love@dl.ac.uk>
-
-	* com.c (ffecom_arglist_expr_): Pass null pointers for optional
-	args which aren't supplied.
-
-Sun Nov 16 21:45:43 1997  H.J. Lu  (hjl@gnu.ai.mit.edu)
-
-	* Make-lang.in (f77.install-info): Depend on f77.info.
-
-1997-11-14  Dave Love  <d.love@dl.ac.uk>
-
-	* intrin.def: Supply gfrt for CPU_TIME.  Generalize arg types of
-	INT2, INT8, per doc.
-
-1997-11-06  Dave Love  <d.love@dl.ac.uk>
-
-	* intrin.def: Allow non-integer args for INT2 and INT8 (per
-	documentation).
-
-Sun Nov  2 19:49:51 1997  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (ffecom_expr_): Only use TREE_TYPE argument for simple
-	arithmetic; convert types as necessary; recurse with target tree type.
-
-Tue Oct 28 02:21:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* lang-options.h: Add -fgnu-intrinsics-* and
-	-fbadu77-intrinsics-* options.
-
-Sun Oct 26 02:36:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (lang_print_error_function): Fix to more
-	reliably notice when the diagnosed region changes.
-
-Sat Oct 25 23:43:36 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix 950327-0.f:
-	* sta.c, sta.h (ffesta_outpooldisp): New function.
-	* std.c (ffestd_stmt_pass_): Don't kill NULL pool.
-	(ffestd_R842): If pool already preserved, save NULL
-	for pool, because it should be killed only once.
-
-	* malloc.c [MALLOC_DEBUG]: Put initializer for `name'
-	component in braces, to avoid compiler warning.
-
-Wed Oct 22 11:37:41 1997  Richard Henderson  <rth@cygnus.com>
-
-	* com.c (ffecom_expr_): Take an new arg TREE_TYPE that if non-null
-	specifies the type in which to do the calculation.  Change all callers.
-	[FFEBLD_opARRAYREF]: Force the index expr to use sizetype.
-
-Thu Oct 16 02:04:08 1997  Paul Koning <pkoning@xedia.com>
-
-	* Make-lang.in (stmp-f2c.h): Don't configure the runtime
-	directory if LANGUAGES does not include f77.
-
-Mon Oct 13 12:12:41 1997  Richard Henderson  <rth@cygnus.com>
-
-	* Make-lang.in (g77*): Copied from cp/Make-lang.in g++*.
-	* g77spec.c: New file, mostly copied from g++spec.c
-	* g77.c: Removed.
-
-Fri Oct 10 13:00:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* ste.c (ffeste_begin_iterdo_): Fix loop setup so iteration
-	variable is modified only after the #iterations is calculated;
-	otherwise if the iteration variable is aliased to any of the
-	operands in the start, end, or increment expressions, the
-	wrong #iterations might be calculated.
-
-	* com.c (ffecom_save_tree): Fix indentation.
-
-Mon Oct  6 14:15:03 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in (f77.mostlyclean): Clean up stuff in the
-	object tree too.
-	(f77.clean, f77.distclean, f77.maintainer-clean): Likewise.
-
-1997-10-05  Dave Love  <d.love@dl.ac.uk>
-
-	* intrin.def: Make SECOND_subr's arg generic real for people
-	porting from Cray and making everything double precision.
-
-Wed Oct  1 01:45:36 1997  Philippe De Muyter  <phdm@info.ucl.ac.be>
-
-	* g77.c (pexecute, main): Use unlink, not remove.
-
-Mon Sep 29 16:18:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* stu.c (ffestu_list_exec_transition_,
-	ffestu_dummies_transition_): Specify `bool' type for
-	`in_progress' variables.
-
-	* com.h (assemble_string): Declare this routine (instead
-	of #include'ing "output.h" from gcc) to eliminate warnings
-	from lex.c.
-
-Mon Sep 29 10:37:07 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* intdoc.c (main): Remove unused attribute for main's arguments.
-
-Sun Sep 28 01:47:17 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in (G77_FLAGS_TO_PASS): Pass down RANLIB, RANLIB_TEST
-	and AR instead of the _FOR_TARGET versions.
-
-Tue Sep 23 00:39:57 1997  Alexandre Oliva <oliva@dcc.unicamp.br>
-
-	* Make-lang.in: install.texi was renamed to g77install.texi
-	* install0.texi: Likewise.
-
-Fri Sep 19 01:12:27 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_reduced_eqop2_):
-	(ffeexpr_reduced_relop2_): Minor fixes to diagnostic code.
-
-	* fini.c (main): Change return type to `int'.
-
-Thu Sep 18 17:31:38 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* proj.h (FFEPROJ_BSEARCH): Delete all references.
-	(FFEPROJ_STRTOUL): Likewise.
-	* proj.c (bsearch): Compile this if no bsearch is provided by the
-	host system.
-	(strtoul): Similarly.
-
-	* g77install.texi: Renamed from install.texi
-	* g77.texi: Corresponding changes.
-
-	* fini.c (main): Return type is int.
-
-	* com.c (lang_printable_name): Use verbosity argument.
-
-Thu Sep 18 16:08:40 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* Make-lang.in: Fix merge problems.
-
-Wed Sep 17 10:47:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com-rt.def (FFECOM_gfrtDSIGN, FFECOM_gfrtISIGN,
-	FFECOM_gfrtSIGN): Add second argument.
-
-	* expr.c (ffeexpr_cb_comma_c_): Trivial fixes.
-
-Sun Sep 14 21:01:23 1997  Jeffrey A Law  (law@cygnus.com)
-
-        * Make-lang.in: Various changes to build info files
-        in the object tree rather than the source tree.
-
-	* proj.h: Include ctype.h.
-
-Sun Sep 14 12:35:20 1997  Fred Fish (fnf@ninemoons.com)
-
-	* proj.h (isascii): Provide a default definition if none is available.
-
-Thu Sep 11 19:26:10 1997  Dave Love <d.love@dl.ac.uk>
-
-	* config-lang.in: Remove the messages about possible build problems.
-
-Wed Sep 10 16:39:47 1997  Jim Wilson  <wilson@cygnus.com>
-
-	* Make-lang.in (LN, LN_S): New macros, use where appropriate.
-
-Tue Sep  9 13:20:40 1997  Jim Wilson  <wilson@cygnus.com>
-
-	* g77.c (pexecute, doit): Add checks for __CYGWIN32__.
-
-Tue Sep  9 01:59:35 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Version 0.5.21 released.
-
-Tue Sep  9 00:31:01 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intdoc.c (dumpem): Put appropriate commentary in
-	output file, so readers know it isn't source.
-
-Wed Aug 27 20:32:03 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* top.c (ffe_decode_option): Turn on flag_move_all_moveables
-	and flag_reduce_all_givs.
-
-Wed Aug 27 08:08:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* proj.h: Always #include "config.j" first, to pick up
-	gcc's configuration.
-	* com.c: Change bcopy() and bzero() calls to memcpy()
-	and memset() calls, to make more of g77 ANSI C.
-
-1997-08-26  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in ($(srcdir)/f/runtime/configure,
- 	$(srcdir)/f/runtime/libU77/configure): Fix for when srcdir isn't
- 	relative.
-
-Tue Aug 26 05:59:21 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* ansify.c (main): Make sure readers of stdout know
-	it's derived from stdin; omit comment text; get source
-	line numbers in future stderr output to be correct.
-
-Tue Aug 26 01:36:01 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix 970825-0.f:
-	* stb.c (ffestb_R5284_): Allow OPEN_PAREN after closing
-	SLASH as well as NAME.
-
-Mon Aug 25 23:48:17 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Changes to allow g77 docs to be built entirely from scratch
-	using any ANSI C compiler, not requiring GNU C:
-	* Make-lang.in ($(srcdir)/f/intdoc.texi): "Pipe" new
-	location of intrinsic documentation data base, f/intdoc.in,
-	through new `ansify' program to append `\n\' to quoted
-	newlines, into f/intdoc.h0.  Do appropriate cleanups.  Explain.
-	(f77.mostlyclean): Add f/ansify and f/intdoc.h0 to cleanups.
-	* f/ansify.c: New program.
-	* f/intdoc.c: Fix so it conforms to ANSI C.
-	#include f/intdoc.h0 instead of f/intdoc.h.
-	Avoid some warnings.
-	* f/intdoc.h, f/intdoc.in: Rename the former to the latter; no
-	changes made to the content in this patch!
-	* f/intrin.h (ffeintrinFamily): Fix to conform to ANSI C.
-
-Mon Aug 25 23:24:32 1997  H.J. Lu  (hjl@gnu.ai.mit.edu)
-
-	* Make-lang.in ($(srcdir)/f/runtime/configure,
-	$(srcdir)/f/runtime/libU77/configure, f77.mostlyclean,
-	f77.clean, f77.distclean, f77.maintainer-clean, f77.realclean):
-	Handle absolute pathname of $(srcdir).
-	(stmp-f2c.h): New.
-	(include/f2c.h, f/runtime/Makefile, f/runtime/libF77/Makefile,
-	f/runtime/libI77/Makefile, f/runtime/libU77/Makefile): Only
-	depend on stmp-f2c.h.
-	(f77.maintainer-clean): Don't make itself.
-
-Sun Aug 24 17:00:27 1997  Jim Wilson  <wilson@cygnus.com>
-
-	* Make-lang.in (f77.install-info): Don't cd into srcdir.  Add srcdir
-	to filenames.  Use sed to extract base filename for install.
-
-Sun Aug 24 06:52:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix up g77 compiler data base for libf2c routines:
-	* com-rt.def (FFECOM_gfrtSIGNAL): Change return type to
-	FTNINT to match actual code.
-
-	* com.c (ffecomRttype_): Replace FFECOM_rttypeINT_ with
-	FFECOM_rttypeFTNINT_.
-	Add and fix up comments.
-	(ffecom_make_gfrt_, ffecom_gfrt_basictype,
-	ffecom_gfrt_kindtype): Replace FFECOM_rttypeINT_ with
-	FFECOM_rttypeFTNINT_; add FFECOM_rttypeDOUBLEREAL_.
-
-Thu Aug 21 13:15:29 1997  Jim Wilson  <wilson@cygnus.com>
-
-	* Make-lang.in (f77): Delete f77-runtime.
-	(f77.all.build, f77.all.cross, f77.rest.encap): Add f77-runtime.
-
-Wed Aug 20 17:18:40 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* global.c (ffeglobal_ref_progunit_): It's okay to have
-	a different CHARACTER*n length for a reference if the
-	existing length is for another reference, not a definition.
-
-Wed Aug 20 16:36:59 1997  Jim Wilson  <wilson@cygnus.com>
-
-	* intdoc.texi: Readd generated file.
-
-Mon Aug 18 14:27:18 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix 970814-0.f:
-	* global.c (ffeglobal_new_progunit_): Distinguish
-	between previously defined, versus inferred, filewide
-	when it comes to diagnostics.
-
-	Fix 970816-1.f:
-	* global.c (ffeglobal_ref_progunit_): Change BDATA into EXT
-	right at the beginning, so EXTERNAL FOO followed later
-	by SUBROUTINE FOO is not diagnosed.
-
-	Fix 970813-0.f:
-	* com-rt.def (FFECOM_gfrtALARM): Returns `integer', not
-	`void'.
-
-Mon Aug 18 09:01:54 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* Makefile.in (F77_OBJS): Re-alphabetize.
-	* Make-lang.in (F77_SRCS): Likewise.
-
-Sun Aug 17 08:35:11 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* INSTALL: Rebuilt.
-	* install.texi: Remove "Object File Differences" section.  Remove
-	all references to zzz.o failing comparison tests.
-	* version.c, version.h: Renamed from zzz.c and zzz.h.  Remove
-	date and time stamps so a 3 stage build reports no differences.
-	* Make-lang.in: Corresponding changes.
-	* Makefile.in: Likewise.
-	* g77.c, parse.c: Likewise.
-
-	* intdoc.texi: Remove generated file from distribution.
-
-Sun Aug 17 03:32:44 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix up problems when virtual memory exhausted:
-	* malloc.c (malloc_new_): Use gcc's xmalloc(), so we
-	print a nicer message when malloc returns no memory.
-	(malloc_resize_): Ditto for xrealloc().
-
-	* Make-lang.in, Makefile.in: Comment out lines containing
-	just formfeeds.
-
-Sat Aug 16 19:41:33 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_make_gfrt_): For rttypeREAL_F2C_, return
-	double_type_node; for rttypeREAL_GNU_, return
-	_real_type_node.
-
-1997-08-13  Dave Love  <d.love@dl.ac.uk>
-
-	* config-lang.in (diff_excludes): Add some hints about known
-	problematic platforms.
-
-1997-08-13  Dave Love  <d.love@dl.ac.uk>
-
-	* intdoc.h: Document `alarm'.
-
-Tue Aug 12 10:23:02 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* config-lang.in: Don't demand the backend patch.
-	* com.c (lang_printable_name): Second argument is now an int.  Don't
-	store into the value of the second argument.
-	* top.c (ffe_decode_option): Temporarily disable setting
-	of "Toon" loop options until we figure out how to address
-	them.
-
-Mon Aug 11 23:18:35 1997  Jeffrey A Law  (law@cygnus.com)
-
-	* g77-0.5.21-19970811 Imported.
-	This file describes changes to the front end necessary to make
-	it work with egcs.
-
-Mon Aug 11 21:19:22 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in ($(RUNTIMESTAGESTUFF)): Add
-	f/runtime/stamp-lib.
-
-Mon Aug 11 01:52:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_build_complex_constant_): Go with the
-	new build_complex() approach used in gcc-2.8.
-
-	* com.c (ffecom_sym_transform_): Don't set
-	DECL_IN_SYSTEM_HEADER for a tree node that isn't
-	a VAR_DECL, which happens when var is in common!
-
-	* com.c (ffecom_expr_intrinsic_) (case FFEINTRIN_impALARM):
-	No need to test codegen_imp -- there's only one valid here.
-
-	* intrin.def (FFEINTRIN_impALARM): Specify `Status' argument
-	as write-only.
-
-Fri Aug  8 05:40:23 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Substantial changes to accommodate distinctions among
-	run-time routines that support intrinsics, and between
-	routines that compute and return the same type vs. those
-	that compute one type and return another (or `void'):
-	* com-rt.def: Specify new return type REAL_F2C_ instead
-	of many DOUBLE_, COMPLEX_F2C_ instead of COMPLEX_, and
-	so on.
-	Clear up the *BES* routines "once and for all".
-	* com.c: New return types.
-	(ffecom_convert_narrow_, ffecom_convert_widen_):
-	New functions that are "safe" variants of convert(),
-	to catch errors that ffecom_expr_intrinsic_() now
-	no longer catches.
-	(ffecom_arglist_expr_): Ensure arguments are not
-	converted to narrower types.
-	(ffecom_call_): Ensure return value is not converted
-	to a wider type.
-	(ffecom_char_args_): Use new ffeintrin_gfrt_direct()
-	routine.
-	(ffecom_expr_intrinsic_): Simplify how run-time
-	routine is selected (via `gfrt' only now; lose the
-	redundant `ix' variable).
-	Eliminate the `library' label; any code that doesn't
-	return directly just `break's out now with `gfrt'
-	set appropriately.
-	Set `gfrt' to default choice initially, either a
-	fast direct form or, if not available, a slower
-	indirect-callable form.
-	(ffecom_make_gfrt_): No longer need to do special
-	check for complex; it's built into the new return-type
-	regime.
-	(ffecom_ptr_to_expr): Use new ffeintrin_gfrt_indirect()
-	routine.
-	* intrin.c, intrin.h: `gfrt' field replaced with three fields,
-	so it is easier to provide faster direct-callable and
-	GNU-convention indirect-callable routines in the future.
-	DEFIMP macro adjusted accordingly, along with all its uses.
-	(ffeintrin_gfrt_direct): New function.
-	(ffeintrin_gfrt_indirect): Ditto.
-	(ffeintrin_is_actualarg): If `-fno-f2c' is in effect,
-	require a GNU-callable version of intrinsic instead of
-	an f2c-callable version, so indirect calling is still checked.
-	* intrin.def: Replace one GFRT field with the three new fields,
-	as appropriate for each DEFIMP intrinsic.
-
-	* com.c (ffecom_stabilize_aggregate_,
-	ffecom_convert_to_complex_): Make these `static'.
-
-Thu Aug  7 11:24:34 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Provide means for front end to determine actual
-	"standard" return type for an intrinsic if it is
-	passed as an actual argument:
-	* com.h, com.c (ffecom_gfrt_basictype,
-	ffecom_gfrt_kindtype): New functions.
-	(ffecom_gfrt_kind_type_): Replaced with new function.
-	All callers updated.
-	(ffecom_make_gfrt_): No longer need do anything
-	with kind type.
-
-	* intrin.c (ffeintrin_basictype, ffeintrin_kindtype):
-	Now returns correct type info for specific intrinsic
-	(based on type of run-time-library implementation).
-
-Wed Aug  6 23:08:46 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* global.c (ffeglobal_ref_progunit_): Don't reset
-	number of arguments just due to new type info,
-	so useful warnings can be issued.
-
-1997-08-06  Dave Love  <d.love@dl.ac.uk>
-
-	* intrin.def: Fix IDATE_vxt argument order.
-	* intdoc.h: Likewise.
-
-Thu Jul 31 22:22:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* global.c (ffeglobal_proc_ref_arg): If REF/DESCR
-	disagreement, DESCR is CHARACTER, and types disagree,
-	pretend the argsummary agrees so the message ends up
-	being about type disagreement.
-	(ffeglobal_proc_def_arg): Ditto.
-
-	* expr.c (ffeexpr_token_first_rhs_3_): Set info for LABTOK
-	to NONE of everything, to avoid misdiagnosing filewide
-	usage of alternate returns.
-
-Sun Jul 20 23:07:47 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_sym_transform_): If type gets set
-	to error_mark_node, just return that for transformed symbol.
-	(ffecom_member_phase2_): If type gets set to error_mark_node,
-	just return.
-	(ffecom_check_size_overflow_): Add `dummy' argument to
-	flag that type is for a dummy, update all callers.
-
-Sun Jul 13 17:40:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix 970712-1.f:
-	* where.c (ffewhere_set_from_track): If start point
-	is too large, just use initial start point.  0.6 should
-	fix all this properly.
-
-	Fix 970712-2.f:
-	* com.c (ffecom_sym_transform_): Preserve error_mark_node for type.
-	(ffecom_type_localvar_): Ditto.
-	(ffecom_sym_transform_): If type is error_mark_node,
-	don't error-check decl size, because back end responds by
-	setting that to an integer 0 instead of error_mark_node.
-	(ffecom_transform_common_): Same as earlier fix to _transform_
-	in that size is checked by dividing BITS_PER_UNIT instead of
-	multiplying.
-	(ffecom_transform_equiv_): Ditto.
-
-	Fix 970712-3.f:
-	* stb.c (ffestb_R10014_): Fix flaky fall-through in error
-	test for FFELEX_typeCONCAT by just replicating the code,
-	and do FFELEX_typeCOLONCOLON while at it.
-
-1997-07-07  Dave Love  <d.love@dl.ac.uk>
-
-	* intdoc.h: Add various missing pieces; correct GMTIME, LTIME
-	result ordering.
-
-	* intrin.def, com-rt.def: Add alarm.
-
-	* com.c (ffecom_expr_intrinsic_): Add case for alarm.
-
-Thu Jun 26 04:19:40 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix 970302-3.f:
-	* com.c (ffecom_sym_transform_): For sanity-check compare
-	of gbe size of local variable to g77 expectation,
-	use varasm.c/assemble_variable technique of dividing
-	BITS_PER_UNIT out of gbe info instead of multiplying
-	g77 info up, to avoid crash when size in bytes is very
-	large, and overflows an `int' or similar when multiplied.
-
-	Fix 970626-2.f:
-	* com.c (ffecom_finish_symbol_transform_): Don't bother
-	transforming a dummy argument, to avoid a crash.
-	* ste.c (ffeste_R1227): Don't return a value if the
-	result decl, or its type, is error_mark_node.
-
-	Fix 970626-4.f:
-	* lex.c (ffelex_splice_tokens): `-fdollar-ok' is
-	irrelevant to whether a DOLLAR token should be made
-	from an initial character of `$'.
-
-	Fix 970626-6.f:
-	* stb.c (ffestb_do3_): DO iteration variable is an
-	lhs, not rhs, expression.
-
-	Fix 970626-7.f and 970626-8.f:
-	* expr.c (ffeexpr_cb_comma_i_1_): Set IMPDO expression
-	to have clean info, because undefined rank, for example,
-	caused crash on mangled source on UltraSPARC but not
-	on Alpha for a series of weird reasons.
-	(ffeexpr_cb_close_paren_): If not CLOSE_PAREN, push
-	opANY expression onto stack instead of attempting
-	to mimic what program might have wanted.
-	(ffeexpr_cb_close_paren_): Don't wrap opPAREN around
-	opIMPDO, just warn that it's gratuitous.
-	* bad.def (FFEBAD_IMPDO_PAREN): New warning.
-
-	Fix 970626-9.f:
-	* expr.c (ffeexpr_declare_parenthesized_): Must shut down
-	parsing in kindANY case, otherwise the parsing engine might
-	decide there's an ambiguity.
-	(ffeexpr_token_name_rhs_): Eliminate parentypeSUBROUTINE_
-	case, so we crash right away if it comes through.
-	* st.c, st.h, sta.c, sta.h (ffest_shutdown, ffesta_shutdown):
-	New functions.
-
-Tue Jun 24 19:47:29 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_check_size_overflow_): New function
-	catches some cases of the size of a type getting
-	too large.  varasm.c must catch the rest.
-	(ffecom_sym_transform_): Use new function.
-	(ffecom_type_localvar_): Ditto.
-
-Mon Jun 23 01:09:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* global.c (ffeglobal_proc_def_arg): Fix comparison
-	of argno to #args.
-	(ffeglobal_proc_ref_arg): Ditto.
-
-	* lang-options.h, top.c: Rename `-fdebug' to `-fxyzzy',
-	since it's an unsupported internals option and some
-	poor user might guess that it does something.
-
-	* bad.def: Make a warning for each filewide diagnostic.
-	Put all filewides together.
-	* com.c (ffecom_sym_transform_): Don't substitute
-	known global tree for global entities when `-fno-globals'.
-	* global.c (ffeglobal_new_progunit_): Don't produce
-	fatal diagnostics about globals when `-fno-globals'.
-	Instead, produce equivalent warning when `-Wglobals'.
-	(ffeglobal_proc_ref_arg): Ditto.
-	(ffeglobal_proc_ref_nargs): Ditto.
-	(ffeglobal_ref_progunit_): Ditto.
-	* lang-options.h, top.c, top.h: New `-fno-globals' option.
-
-Sat Jun 21 12:32:54 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_fulfill_call_): Set array variable
-	to avoid warning about uninitialized variable.
-
-	* Make-lang.in: Get rid of any setting of HOST_* macros,
-	since these will break gcc's build!
-	* makefile: New file to make building derived files
-	easier.
-
-Thu Jun 19 18:19:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* g77.c (main): Install Emilio Lopes' patch to support
-	Ratfor, and to fix the printing of the version string
-	to go to stderr, not stdout.
-	* lang-specs.h: Install Emilio Lopes' patch to support
-	Ratfor, and patch the result to support picking up
-	`*f771' from the `specs' file.
-
-Thu Jun 12 14:36:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* storag.c (ffestorag_update_init, ffestorag_update_save):
-	Also update parent, in case equivalence processing
-	has already eliminated pointers to it via the
-	local equivalence info.
-
-Tue Jun 10 14:08:26 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intdoc.c: Add cross-reference to end of description
-	of any generic intrinsic pointing to other intrinsics
-	with the same name.
-
-	Warn about explicit type declaration for intrinsic
-	that disagrees with invocation:
-	* expr.c (ffeexpr_paren_rhs_let_): Preserve type info
-	for intrinsic functions.
-	(ffeexpr_token_funsubstr_): Ditto.
-	* intrin.c (ffeintrin_fulfill_generic): Warn if type
-	info of fulfilled intrinsic invocation disagrees with
-	explicit type info given symbol.
-	(ffeintrin_fulfill_specific): Ditto.
-	* stc.c (ffestc_R1208_item): Preserve type info
-	for intrinsics.
-	(ffestc_R501_item): Ditto.
-
-Mon Jun  9 17:45:44 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_expr_intrinsic_): Fix several of the
-	libU77/libF77-unix handlers to properly convert their
-	arguments.
-
-	* com-rt.def (FFECOM_gfrtFSTAT): Append missing "i" to
-	arg string.
-
-Fri Jun  6 14:37:30 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_expr_intrinsic_): Have a case statement
-	for every intrinsic implementation, so missing ones
-	are caught via gcc warnings.
-	Don't call ffeintrin_codegen_imp anymore.
-	* intrin.c (ffeintrin_fulfill_generic): Remove cg_imp
-	stuff from here.
-	(ffeintrin_codegen_imp): Delete this function.
-	* intrin.def, intrin.h: Remove DEFIMQ stuff from here
-	as well.
-
-Thu Jun  5 13:03:07 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* top.c (ffe_decode_option): New -fbadu77-intrinsics-*
-	options.
-	* top.h: Ditto.
-	* intrin.h: New BADU77 family.
-	* intrin.c (ffeintrin_state_family): Ditto.
-
-	Implement new scheme to track intrinsic names vs. forms:
-	* intrin.c (ffeintrin_fulfill_generic),
-	(ffeintrin_fulfill_specific), (ffeintrin_is_intrinsic),
-	intrin.def: The documented name is now either in the
-	generic info or, if no generic, in the specific info.
-	For a generic, the specific info contains merely the
-	distinguishing form (usually "function" or "subroutine"),
-	used for diagnostics about ambiguous references and
-	in the documentation.
-
-	* intrin.def: Clean up formatting of DEFNAME block.
-	Convert many libU77 intrinsics into generics that
-	support both subroutine and function forms.
-	Put the function forms of side-effect routines into
-	the new BADU77 family.
-	Make MCLOCK and TIME return INTEGER*4 again, and add
-	INTEGER*8 equivalents called MCLOCK8 and TIME8.
-	Fix up more status return values to be written and
-	insist on them being I1 as well.
-	* com.c (ffecom_expr_intrinsic_): Lots of changes to
-	support new libU77 intrinsic interfaces.
-
-Mon Jun  2 00:37:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_init_0): Pointer type is now INTEGER(KIND=7),
-	not INTEGER(KIND=0), since we want to reserve KIND=0 for
-	future use.
-
-Thu May 29 14:30:33 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix bugs preventing CTIME(I*4) from working correctly:
-	* com.c (ffecom_char_args_): For FUNCREF case, process
-	args to intrinsic just as they would be in
-	ffecom_expr_intrinsic_.
-	* com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtTTYNAM): Fix
-	argument decls to specify `&'.
-
-Wed May 28 22:19:49 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix gratuitous warnings exposed by dophot aka 970528-1:
-	* global.c (ffeglobal_proc_def_arg, ffeglobal_proc_ref_arg):
-	Support distinct function/subroutine arguments instead of
-	just procedures.
-	* global.h: Ditto.
-	* expr.c (ffeexpr_fulfill_call_): A SYMTER with kindNONE
-	also is a procedure (either function or subroutine).
-
-Mon May 26 20:25:31 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* bad.def: Have several lexer diagnostics refer to
-	documentation for people who need more info on what Fortran
-	source code is supposed to look like.
-
-	* expr.c (ffeexpr_reduced_bool1_), bad.def: New diagnostics
-	specific to .NOT. now mention only one operand instead
-	of two.
-
-	* g77.c: Recognize -fsyntax-only, similar to -c etc.
-	(lookup_option): Fix bug that prevented non-`--' options
-	from being recognized.
-
-Sun May 25 04:29:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intrin.def (FFEINTRIN_impCTIME): Accept `I*' expression
-	for STime instead of requiring `I2'.
-
-Tue May 20 16:14:40 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* symbol.c (ffesymbol_reference): All references to
-	standard intrinsics are considered explicit, so as
-	to avoid generating basically useless warnings.
-	* intrin.c, intrin.h (ffeintrin_is_standard): Returns TRUE
-	if intrinsic is standard.
-
-Sun May 18 21:14:59 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com-rt.def: Changed all external names of the
-	form `"\([a-z0-9]*\)_' to `"G77_\1_0"' so as to
-	allow any name valid as an intrinsic to be used
-	as such and as a user-defined external procedure
-	name or common block as well.
-
-Thu May  8 13:07:10 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_cb_end_notloc_): For %VAL, %REF, and
-	%DESCR, copy arg info into new node.
-
-Mon May  5 14:42:17 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	From Uwe F. Mayer <mayer@math.Vanderbilt.Edu>:
-	* Make-lang.in (g77-cross): Fix typo in g77.c path.
-
-	From Brian McIlwrath <bkm@star.rl.ac.uk>:
-	* lang-specs.h: Have g77 pick up options from a section
-	labeled `*f771' of the `specs' file.
-
-Sat May  3 02:46:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intrin.def (FFEINTRIN_defSIGNAL): Add optional `Status'
-	argument that com.c already expects (per Dave Love).
-
-	More changes to support better tracking of (filewide)
-	globals, in particular, the arguments to procedures:
-	* bad.def (FFEBAD_FILEWIDE_NARGS, FFEBAD_FILEWIDE_NARGS_W,
-	FFEBAD_FILEWIDE_ARG, FFEBAD_FILEWIDE_ARG_W): New diagnostics.
-	* expr.c (ffebad_fulfill_call_): Provide info on each
-	argument to ffeglobal.
-	* global.c, global.h (ffeglobal_proc_def_arg,
-	ffeglobal_proc_def_nargs, ffeglobal_proc_ref_arg,
-	ffeglobal_proc_ref_args): New functions.
-	(ffeglobalArgSummary, ffeglobalArgInfo_): New types.
-
-Tue Apr 29 18:35:41 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	More changes to support better tracking of (filewide)
-	globals:
-	* expr.c (ffeexpr_fulfill_call_): New function.
-	(ffeexpr_token_name_lhs_): Call after building procedure
-	reference expression.  Also leave info field for ANY-ized
-	expression alone.
-	(ffeexpr_token_arguments_): Ditto.
-
-Mon Apr 28 20:04:18 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Changes to support better tracking of (filewide)
-	globals, mainly to avoid crashes due to inlining:
-	* bad.def: Go back to quoting intrinsic names,
-	(FFEBAD_FILEWIDE_DISAGREEMENT, FFEBAD_FILEWIDE_TIFF,
-	FFEBAD_FILEWIDE_TYPE_MISMATCH): New diagnostics.
-	(FFEBAD_INTRINSIC_EXPIMP, FFEBAD_INTRINSIC_GLOBAL): Reword
-	for clarity.
-	* com.c (ffecom_do_entry_, ffecom_start_progunit_,
-	ffecom_sym_transform_): Accommodate new FFEGLOBAL_typeEXT
-	possibility.
-	* expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_extfunc_,
-	ffeexpr_sym_rhs_actualarg_, ffeexpr_declare_parenthesized_,
-	ffeexpr_paren_rhs_let_, ffeexpr_token_funsubstr_):
-	Fill in real kind info instead of leaving NONE where
-	appropriate.
-	Register references to intrinsics and globals with ffesymbol
-	using new ffesymbol_reference function instead of
-	ffesymbol_globalize.
-	* global.c (ffeglobal_type_string_): New array for
-	new diagnostics.
-	* global.h, global.c:
-	Replace ->init mechanism with ->tick mechanism.
-	Move other common-related members into a substructure of
-	a union, so the proc substructure can be introduced
-	to include members related to externals other than commons.
-	Don't complain about ANY-ized globals; ANY-ize globals
-	once they're complained about, in any case where code
-	generation could become a problem.
-	Handle global entries that have NONE type (seen as
-	intrinsics), EXT type (seen as EXTERNAL), and so on.
-	Keep track of kind and type of externals, both via
-	definition and via reference.
-	Diagnose disagreements about kind or type of externals
-	(such as functions).
-	(ffeglobal_ref_intrinsic, ffeglobal_ref_progunit_): New
-	functions.
-	* stc.c (ffestc_R1207_item, ffestc_R1208_item,
-	ffestc_R1219, ffestc_R1226):
-	Call ffesymbol_reference, not ffesymbol_globalize.
-	* stu.c (ffestu_sym_end_transition,
-	ffestu_sym_exec_transition):
-	Call ffesymbol_reference, not ffesymbol_globalize.
-	* symbol.c (ffesymbol_globalize): Removed...
-	(ffesymbol_reference): ...to this new function,
-	which more generally registers references to symbols,
-	globalizes globals, and calls on the ffeglobal module
-	to check globals filewide.
-
-	* global.h, global.c: Rename some macros and functions
-	to more clearly distinguish common from other globals.
-	All callers changed.
-
-	* com.c (ffecom_sym_transform_): Trees describing
-	filewide globals must be allocated on permanent obstack.
-
-	* expr.c (ffeexpr_token_name_lhs_): Don't generate
-	gratuitous diagnostics for FFEINFO_whereANY case.
-
-Thu Apr 17 03:27:18 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* global.c: Add support for flagging intrinsic/global
-	confusion via warnings.
-	* bad.def (FFEBAD_INTRINSIC_EXPIMP,
-	FFEBAD_INTRINSIC_GLOBAL): New diagnostics.
-	* expr.c (ffeexpr_token_funsubstr_): Ditto.
-	(ffeexpr_sym_lhs_call_): Ditto.
-	(ffeexpr_paren_rhs_let_): Ditto.
-	* stc.c (ffestc_R1208_item): Ditto.
-
-Wed Apr 16 22:40:56 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_declare_parenthesized_): INCLUDE
-	context can't be an intrinsic invocation either.
-
-Fri Mar 28 10:43:28 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_token_arguments_): Make sure top of
-	exprstack is operand before dereferencing operand field.
-
-	* lex.c (ffelex_prepare_eos_): Fill up truncated
-	hollerith token, so crash on null ->text field doesn't
-	happen later.
-
-	* stb.c (ffestb_R10014_): If NAMES isn't recognized (or
-	the recognized part is followed in the token by a
-	non-digit), don't try and collect digits, as there
-	might be more than FFEWHERE_indexMAX letters to skip
-	past to do so -- and the code is diagnosed anyway.
-
-Thu Mar 27 00:02:48 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_sym_transform_): Force local
-	adjustable array onto stack.
-
-	* stc.c (ffestc_R547_item_object): Don't actually put
-	the symbol in COMMON if the symbol has already been
-	EQUIVALENCE'd to a different COMMON area.
-
-	* equiv.c (ffeequiv_add): Don't actually do anything
-	if there's a disagreement over which COMMON area is
-	involved.
-
-Tue Mar 25 03:35:19 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_transform_common_): If no explicit init
-	of COMMON area, don't actually init it even though
-	storage area suggests it.
-
-Mon Mar 24 12:10:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* lex.c (ffelex_image_char_): Avoid overflowing the
-	column counter itself, as well as the card image.
-
-	* where.c (ffewhere_line_new): Cast ffelex_line_length()
-	to (size_t) so 255 doesn't overflow to 0!
-
-	* stc.c (ffestc_labeldef_notloop_begin_): Don't gratuitously
-	terminate loop before processing statement, so block
-	doesn't disappear out from under EXIT/CYCLE processing.
-	(ffestc_labeldef_notloop_): Has old code from above
-	function, instead of just calling it.
-
-	* expr.c (ffeexpr_cb_comma_i_4_): Don't skip over
-	arbitrary token (such as EOS).
-
-	* com.c (ffecom_init_zero_): Handle RECORD_TYPE and
-	UNION_TYPE so -fno-zeros works with -femulated-complex.
-
-1997-03-12  Dave Love  <d.love@dl.ac.uk>
-
-	* intrin.def: New intrinsics INT2, INT8, CPU_TIME.  Fix AND, OR,
- 	XOR.  [Integrated by burley, AND/OR/XOR already fixed, INT8
-	implementation changed/fixed.]
-
-Wed Mar 12 10:40:08 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in ($(srcdir)/f/intdoc.texi): Simplify rules
-	so building f/intdoc is not always necessary; remove
-	f/intdoc after running it if it is built.
-
-Tue Mar 11 23:42:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intrin.def (FFEINTRIN_impAND, FFEINTRIN_impOR,
-	FFEINTRIN_impXOR): Use the IAND, IOR, and IEOR implementations
-	of these, instead of crashing in ffecom_expr_intrinsic_
-	or adding case labels there.
-
-Mon Mar 10 22:51:23 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intdoc.c: Fix so any C compiler can compile this.
-
-Fri Feb 28 13:16:50 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Version 0.5.20 released.
-
-Fri Feb 28 01:45:25 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in (RUNTIMESTAGESTUFF, LIBU77STAGESTUFF):
-	Move some files incorrectly in the former to the latter,
-	and add another file or two to the latter.
-
-	New meanings for (KIND=n), and new denotations in the
-	little language describing intrinsics:
-	* com.c (ffecom_init_0): Assign new meanings.
-	* intdoc.c: Document new meanings.
-	Support the new denotations.
-	* intrin.c: Employ new meanings, mapping them to internal
-	values (which are the same as they ever were for now).
-	Support the new denotations.
-	* intrin.def: Switch DEFIMP table to the new denotations.
-
-	* intrin.c (ffeintrin_check_): Fix bug that was leaving
-	LOC() and %LOC() returning INTEGER*4 on systems where
-	it should return INTEGER*8.
-
-	* type.c: Canonicalize function definitions, for etags
-	and such.
-
-Wed Feb 26 20:43:03 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_init_0): Choose INTEGER(KIND=n) types,
-	where n is 2, 3, and 4, according to the new docs
-	instead of according to the old C correspondences
-	(which seem less useful at this point).
-
-	* equiv.c (ffeequiv_destroy_): New function.
-	(ffeequiv_layout_local_): Use this new function
-	whenever the laying out of a local equivalence chain
-	is aborted for any reason.
-	Otherwise ensure that symbols no longer reference
-	the stale ffeequiv entries that result when they
-	are killed off in this procedure.
-	Also, the rooted symbol is one that has storage,
-	it really is irrelevant whether it has an equiv entry
-	at this point (though the code to remove the equiv
-	entry was put in at the end, just in case).
-	(ffeequiv_kill): When doing internal checks, make
-	sure the victim isn't named by any symbols it points
-	to.  Not as complete a check as looking through the
-	entire symbol table (which does matter, since some
-	code in equiv.c used to remove symbols from the lists
-	for an ffeequiv victim but not remove that victim as the
-	symbol's equiv info), but this check did find some
-	real bugs in the code (that were fixed).
-
-Mon Feb 24 16:42:13 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_expr_intrinsic_): Fix a couple of
-	warnings about uninitialized variables.
-	* intrin.c (ffeintrin_check_): Ditto, but there were
-	a couple of _real_ uninitialized-variable _bugs_ here!
-	(ffeintrin_fulfill_specific): Ditto, no real bug here.
-
-Sun Feb 23 15:01:20 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Clean up diagnostics (especially about intrinsics):
-	* bad.def (FFEBAD_UNIMPL_STMT): Remove.
-	(FFEBAD_INTRINSIC_*, FFEBAD_NEED_INTRINSIC): Clean these
-	up so they're friendlier.
-	(FFEBAD_INTRINSIC_CMPAMBIG): New.
-	* intrin.c (ffeintrin_fulfill_generic,
-	ffeintrin_fulfill_specific, ffeintrin_is_intrinsic):
-	Always choose
-	generic or specific name text (which is for doc purposes
-	anyway) over implementation name text (which is for
-	internal use).
-	* intrin.def: Use more descriptive name texts for generics
-	and specifics in cases where the names themselves are not
-	enough (e.g. IDATE, which has two forms).
-
-	Fix some intrinsic mappings:
-	* intrin.def (FFEINTRIN_specIDINT, FFEINTRIN_specAND,
-	FFEINTRIN_specDFLOAT, FFEINTRIN_specDREAL, FFEINTRIN_specOR,
-	FFEINTRIN_specXOR): Now have their own implementations,
-	instead of borrowing from others.
-	(FFEINTRIN_specAJMAX0, FFEINTRIN_specAJMIN0, FFEINTRIN_specBJTEST,
-	FFEINTRIN_specDFLOTJ, FFEINTRIN_specFLOATJ, FFEINTRIN_specJIABS,
-	FFEINTRIN_specJIAND, FFEINTRIN_specJIBCLR, FFEINTRIN_specJIBITS,
-	FFEINTRIN_specJIBSET, FFEINTRIN_specJIDIM, FFEINTRIN_specJIDINT,
-	FFEINTRIN_specJIDNNT, FFEINTRIN_specJIEOR, FFEINTRIN_specJIFIX,
-	FFEINTRIN_specJINT, FFEINTRIN_specJIOR, FFEINTRIN_specJISHFT,
-	FFEINTRIN_specJISHFTC, FFEINTRIN_specJISIN, FFEINTRIN_specJMAX0,
-	FFEINTRIN_specJMAX1, FFEINTRIN_specJMIN0, FFEINTRIN_specJMIN1,
-	FFEINTRIN_specJMOD, FFEINTRIN_specJNINT, FFEINTRIN_specJNOT,):
-	Turn these implementations off, since it's not clear
-	just what types they expect in the context of portable Fortran.
-	(DFLOAT): Now in FVZ family, since f2c supports them
-
-	Support intrinsic inquiry functions (BIT_SIZE, LEN):
-	* intrin.c: Allow `i' in <arg_extra>.
-	* intrin.def (FFEINTRIN_impBIT_SIZE, FFEINTRIN_impLEN):
-	Mark args with `i'.
-
-Sat Feb 22 13:34:09 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Only warn, don't error, for reference to unimplemented
-	intrinsic:
-	* bad.def (FFEBAD_INTRINSIC_UNIMPLW): Warning version
-	of _UNIMPL.
-	* intrin.c (ffeintrin_is_intrinsic): Use new warning
-	version of _UNIMPL (FFEBAD_INTRINSIC_UNIMPLW).
-
-	Complain about REAL(Z) and AIMAG(Z) (Z is DOUBLE COMPLEX):
-	* bad.def (FFEBAD_INTRINSIC_CMPAMBIG): New diagnostic.
-	* expr.c: Needed #include "intrin.h" anyway.
-	(ffeexpr_token_intrincheck_): New function handles delayed
-	diagnostic for "REAL(REAL(expr)" if next token isn't ")".
-	(ffeexpr_token_arguments_): Do most of the actual checking here.
-	* intrin.h, intrin.c (ffeintrin_fulfill_specific): New
-	argument, check_intrin, to tell caller that intrin is REAL(Z)
-	or AIMAG(Z).  All callers updated, mostly to pass NULL in
-	for this.
-	(ffeintrin_check_): Also has new arg check_intrin for same
-	purpose.  All callers updated the same way.
-	* intrin.def (FFEINTRIN_impAIMAG): Change return type
-	from "R0" to "RC", to accommodate f2c (and perhaps other
-	non-F90 F77 compilers).
-	* top.h, top.c: New option -fugly-complex.
-
-	New GNU intrinsics REALPART, IMAGPART, and COMPLEX:
-	* com.c (ffecom_expr_intrinsic_): Implement impCOMPLEX
-	and impREALPART here.  (specIMAGPART => specAIMAG.)
-	* intrin.def: Add the intrinsics here.
-
-	Rename implementations of VXTIDATE and VXTTIME to IDATEVXT
-	and TIMEVXT, so they sort more consistently:
-	* com.c (ffecom_expr_intrinsic_):
-	* intrin.def:
-
-	Delete intrinsic group `dcp', add `gnu', etc.:
-	* intrin.c (ffeintrin_state_family): FFEINTRIN_familyGNU
-	replaces FFEINTRIN_familyDCP, and gets state from `gnu'
-	group.
-	Get rid of FFEINTRIN_familyF2Z, nobody needs it.
-	Move FFEINTRIN_specDCMPLX from DCP family to FVZ family,
-	as f2c has it.
-	Move FFEINTRIN_specDFLOAT from F2C family to FVZ family.
-	(FFEINTRIN_specZABS, FFEINTRIN_specZCOS, FFEINTRIN_specZEXP,
-	FFEINTRIN_specZLOG, FFEINTRIN_specZSIN, FFEINTRIN_specZSQRT):
-	Move these from F2Z family to F2C family.
-	* intrin.h (FFEINTRIN_familyF2Z, FFEINTRIN_familyDCP): Remove.
-	(FFEINTRIN_familyGNU): Add.
-	* top.h, top.c: Replace `dcp' with `gnu'.
-
-	* com.c (ffecom_expr_intrinsic_): Clean up by collecting
-	simple conversions into one nice, conceptual place.
-	Fix up some intrinsic subroutines (MVBITS, KILL, UMASK) to
-	properly push and pop call temps, to avoid wasting temp
-	registers.
-
-	* g77.c (doit): Toon says variables should be defined
-	before being referenced.  Spoilsport.
-
-	* intrin.c (ffeintrin_check_): Now Dave's worried about
-	warnings about uninitialized variables.  Okay, so for
-	basic return values 'g' and 's', they _were_
-	uninitialized -- is determinism really _that_ useful?
-
-	* intrin.def (FFEINTRIN_impFGETC): Fix STATUS argument
-	so that it is INTENT(OUT) instead of INTENT(IN).
-
-1997-02-21  Dave Love  <d.love@dl.ac.uk>
-
-	* intrin.def, com.c: Support Sun-type `short' and `long'
-	intrinsics.  Perhaps should also do Microcruft-style `int2'.
-
-Thu Feb 20 15:16:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_expr_intrinsic_): Clean up indentation.
-	Support SECONDSUBR intrinsic implementation.
-	Rename SECOND to SECONDFUNC for direct support via library.
-
-	* g77.c: Fix to return proper status value to shell,
-	by obtaining it from processes it spawns.
-
-	* intdoc.c: Fix minor typo.
-
-	* intrin.def: Turn SECOND into generic that maps into
-	function and subroutine forms.
-
-	* intrin.def: Make FLOAT and SNGL into specific intrinsics.
-
-	* intrin.def, intrin.h: Change the way DEFGEN and DEFSPEC
-	macros work, to save on verbage.
-
-Mon Feb 17 02:08:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	New subsystem to automatically generate documentation
-	on intrinsics:
-	* Make-lang.in ($(srcdir)/f/g77.info,
-	$(srcdir)/f/g77.dvi): Move g77 doc rules around.
-	Add to g77 doc rules the new subsystem.
-	(f77.mostlyclean, f77.maintainer-clean): Also clean up
-	after new doc subsystem.
-	* intdoc.c, intdoc.h: New doc subsystem code.
-	* intrin.h [FFEINTRIN_DOC]: When 1, don't pull in
-	stuff not needed by doc subsystem.
-
-	Improve on intrinsics mechanism to both be more
-	self-documenting and to catch more user errors:
-	* intrin.c (ffeintrin_check_): Recognize new arg-len
-	and arg-rank information, and check it.
-	Move goto and signal indicators to the basic type.
-	Permit reference to arbitrary argument number, not
-	just first argument (for BESJN and BESYN).
-	(ffeintrin_init_0): Check and accept new notations.
-	* intrin.c, intrin.def: Value in COL now identifies
-	arguments starting with number 0 being the first.
-
-	Some minor intrinsics cleanups (resulting from doc work):
-	* com.c (ffecom_expr_intrinsic_): Implement FLUSH
-	directly once again, handle its optional argument,
-	so it need not be a generic (awkward to handle in docs).
-	* intrin.def (BESJ0, BESJ1, BESJN, BESY0, BESY1, BESYN,
-	CHDIR, CHMOD, CTIME, DBESJ0, DBESJ1, DBESJN, DBESY0,
-	DBESY1, DBESYN, DDIM, ETIME, FGETC, FNUM, FPUTC, FSTAT,
-	GERROR, GETCWD, GETGID, GETLOG, GETPID, GETUID, GMTIME,
-	HOSTNM, IDATE, IERRNO, IIDINT, IRAND, ISATTY, ITIME, JIDINT,
-	LNBLNK, LSTAT, LTIME, MCLOCK, PERROR, SRAND, SYMLNK, TTYNAM,
-	UMASK): Change capitalization of initcaps (official) name
-	to be consistent with Burley's somewhat arbitrary rules.
-	(BESJN, BESYN): These have return arguments of same type
-	as their _second_ argument.
-	(FLUSH): Now a specific, not generic, intrinsic, with one
-	optional argument.
-	(FLUSH1): Eliminated.
-	Add arg-len and arg-rank info to several intrinsics.
-	(ITIME): Change argument type from REAL to INTEGER.
-
-Tue Feb 11 14:04:42 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in (f771): Invocation of Makefile now done
-	with $(srcdir)=gcc to go along with $(VPATH)=gcc.
-	($(srcdir)/f/runtime/configure,
-	$(srcdir)/f/runtime/libU77/configure): Break these out
-	so spurious triggers of this rule don't happen (as when
-	configure.in is more recent than libU77/configure).
-	(f77.rebuilt): Distinguish source versus build files,
-	so this target can be invoked from build directory and
-	still work.
-	* Makefile.in: This now expects $(srcdir) to be the gcc
-	source directory, not gcc/f, to agree with $(VPATH).
-	Accordingly, $(INCLUDES) has been fixed, various cruft
-	removed, the removal of f771 has been fixed to remove
-	the _real_ f771 (not the one in gcc's parent directory),
-	and so on.
-
-	* lex.c: Part of ffelex_finish_statement_() now done
-	by new function ffelex_prepare_eos_(), so that, in one
-	popular case, the EOS can be prepared while the pointer
-	is at the end of the non-continued line instead of the
-	end of the line that marks no continuation.  This improves
-	the appearance of diagnostics substantially.
-
-Mon Feb 10 12:44:06 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in: runtime Makefile's, and include/f2c.h,
-	also depend on f/runtime/configure and f/runtime/libU77/configure.
-
-	Fix various libU77 routines:
-	* com-rt.def (FFECOM_gfrtCTIME, FFECOM_gfrtMCLOCK,
-	FFECOM_gfrtTIME): These now use INTEGER*8 for time values,
-	for compatibility with systems like Alpha.
-	(FFECOM_gfrtSYSTEM_CLOCK, FFECOM_gfrtTTYNAM): Delete incorrect
-	trailing underscore in routine names.
-	* intrin.c, intrin.def: Support INTEGER*8 return values and
-	arguments ('4').  Change FFEINTRIN_impCTIME, FFEINTRIN_impMCLOCK,
-	and FFEINTRIN_impTIME accordingly.
-	(ffeintrin_is_intrinsic): Don't give caller a clue about
-	form of intrinsic -- shouldn't be needed at this point.
-
-	Cope with generic intrinsics that are subroutines and functions:
-	* com.c (ffecom_finish_symbol_transform_, ffecom_expr_transform_):
-	Don't transform an intrinsic that is not known to be a subroutine
-	or a function.  (Maybe someday have to avoid transforming
-	any intrinsic with an undecided or unknown implementation.)
-	* expr.c (ffeexpr_declare_unadorned_,
-	ffeexpr_declare_parenthesized_): Ok to invoke generic
-	intrinsic that has at least one subroutine form as a
-	subroutine.
-	Ok to pass intrinsic as actual arg if it has a known specific
-	intrinsic form that is valid as actual arg.
-	(ffeexpr_declare_parenthesized_): An unknown kind of
-	intrinsic has a paren_type chosen based on context.
-	(ffeexpr_token_arguments_): Build funcref/subrref based
-	on context, not on kind of procedure being called.
-	* intrin.h, intrin.c (ffeintrin_is_intrinsic): Undo changes of
-	Tue Feb  4 23:12:04 1997 by me, change all callers to leave
-	intrinsics as FFEINFO_kindNONE at this point.  (Some callers
-	also had unused variables deleted as a result.)
-
-	Enable all intrinsic groups (especially f90 and vxt):
-	* target.h (FFETARGET_defaultSTATE_DCP, FFETARGET_defaultSTATE_F2C,
-	FFETARGET_defaultSTATE_F90, FFETARGET_defaultSTATE_MIL,
-	FFETARGET_defaultSTATE_UNIX, FFETARGET_defaultSTATE_VXT):
-	Delete these macros, let top.c set them directly.
-	* top.c (ffeintrinsic_state_dcp_, ffe_intrinsic_state_f2c_,
-	ffe_intrinsic_state_f90_, ffe_intrinsic_state_mil_,
-	ffe_intrinsic_state_unix_, ffe_intrinsic_state_vxt_):
-	Enable all these directly.
-
-Sat Feb  8 03:21:50 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* g77.c: Incorporate recent changes to ../gcc.c.
-	For version magic (e.g. `g77 -v'), instead of compiling
-	/dev/null, write, compile, run, and then delete a small
-	program that prints the version numbers of the three
-	components of libf2c (libF77, libI77, and libU77),
-	so we get this info with bug reports.
-	Also, this change reduces the chances of accidentally
-	linking to an old (complex-alias-problem) libf2c.
-	Fix `-L' so the argument is expected in `-Larg'.
-
-	* com.h (FFECOM_f2cLONGINT): For INTEGER*8 support in f2c.h,
-	dynamically determine proper type here, instead of
-	assuming `long long int' is correct.
-
-Tue Feb  4 23:12:04 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Add libU77 library from Dave Love <d.love@dl.ac.uk>:
-	* Make-lang.in (f77-runtime): Depend on new Makefile.
-	(f/runtime/libU77/Makefile): New rule.
-	Also configure libU77.
-	($(srcdir)/f/runtime/configure: Use Makefile.in,
-	so configuration doesn't have to have happened.
-	(f77.mostlyclean, f77.clean, f77.distclean,
-	f77.maintainer-clean): Some fixups here, but more work
-	needed.
-	(RUNTIMESTAGESTUFF): Add libU77's config.status.
-	(LIBU77STAGESTUFF, f77.stage1, f77.stage2, f77.stage3,
-	f77.stage4): New macro, appropriate uses added.
-	* com-rt.def: Add libU77 procedures.
-	* com.c (ffecom_f2c_ptr_to_integer_type_node,
-	ffecom_f2c_ptr_to_real_type_node): New type nodes.
-	(FFECOM_rttypeCHARACTER_): New type of run-time function.
-	(ffecom_char_args_): Handle CHARACTER*n intrinsics
-	where n != 1 here, instead of in ffecom_expr_intrinsic_.
-	(ffecom_expr_intrinsic_): New code to handle new
-	intrinsics.
-	In particular, change how FFEINTRIN_impFLUSH is handled.
-	(ffecom_make_gfrt_): Handle new type of run-time function.
-	(ffecom_init_0): Initialize new type nodes.
-	* config-lang.in: New libU77 directory.
-	* intrin.h, intrin.c (ffeintrin_is_intrinsic): Handle
-	potential generic for subroutine _and_ function
-	specifics via two new arguments.  All callers changed.
-	Properly ignore deleted/disabled intrinsics in resolving
-	generics.
-	(ffeintrin_check_, ffeintrin_init_0): Handle CHARACTER intrinsics of (*)
-	length.
-	* intrin.def: Permission granted by FSF to place this in
-	public domain, which will allow it to serve as source
-	for both g77 program and its documentation.
-	Add libU77 intrinsics.
-	(FLUSH): Now a generic, not specific, intrinsic.
-	(DEFIMP): Now support return modifier for CHARACTER intrinsics.
-
-	* com-rt.def (FFECOM_gfrtDIM, FFECOM_gfrtERF,
-	FFECOM_gfrtERFC, FFECOM_gfrtEXP, FFECOM_gfrtSIGN,
-	FFECOM_gfrtSIN, FFECOM_gfrtSINH, FFECOM_gfrtTAN,
-	FFECOM_gfrtTANH, FFECOM_gfrtPOW_RI): Change "&r" to "&f".
-
-Sat Feb  1 12:15:09 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Version 0.5.19.1 released.
-
-	* com.c (ffecom_expr_, ffecom_expr_intrinsic_,
-	ffecom_tree_divide_): FFECOM_gfrtPOW_ZI,
-	FFECOM_gfrtCONJG, FFECOM_gfrtDCONJG,
-	FFECOM_gfrtCCOS, FFECOM_gfrtCDCOS,
-	FFECOM_gfrtCLOG, FFECOM_gfrtCDLOG,
-	FFECOM_gfrtCSIN, FFECOM_gfrtCDSIN,
-	FFECOM_gfrtCSQRT, FFECOM_gfrtCDSQRT,
-	FFECOM_gfrtDIV_CC, FFECOM_gfrtDIV_ZZ: These all require
-	result to _not_ overlap one or more inputs.
-
-Sat Feb  1 00:25:55 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_init_0): Do internal checks only if
-	-fset-g77-defaults not specified.
-
-	Fix %LOC(), LOC() to return sufficiently wide type:
-	* com.h, com.c (ffecom_pointer_kind_, ffecom_label_kind_,
-	ffecom_pointer_kind(), ffecom_label_kind()): New globals
-	and accessor macros hold kind for integer pointers on target
-	machine.
-	(ffecom_init_0): Determine narrowest INTEGER type that
-	can hold a pointer (usually INTEGER*4 or INTEGER*8),
-	store it in ffecom_pointer_kind_, etc.
-	* expr.c (ffeexpr_cb_end_loc_): Use right type for %LOC().
-	* intrin.c (ffeintrin_check_, ffeintrin_init_0): Support
-	new 'p' kind for type of intrinsic.
-	* intrin.def (FFEINTRIN_impLOC): Returns "Ip" instead of "I1",
-	so LOC() type is correct for target machine.
-
-	Support -fugly-assign:
-	* lang-options.h, top.h, top.c (ffe_decode_option):
-	Accept -fugly-assign and -fno-ugly-assign.
-	* com.c (ffecom_expr_): Handle -fugly-assign.
-	* expr.c (ffeexpr_finished_): Check right type for ASSIGN
-	contexts.
-
-Fri Jan 31 14:30:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Remove last vestiges of -fvxt-not-f90:
-	* stb.c (ffestb_R10012_, ffestb_R10014_, ffestb_V0201_):
-	top.c, top.h:
-
-Fri Jan 31 02:13:54 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* top.c (ffe_decode_option): Warn if -fugly is specified,
-	it'll go away soon.
-
-	* symbol.h: No need to #include "bad.h".
-
-	Reorganize features from -fvxt-not-f90 to -fvxt:
-	* lang-options.h, top.h, top.c:
-	Accept -fvxt and -fno-vxt, but not -fvxt-not-f90 or -ff90-not-vxt.
-	Warn if the latter two are used.
-	* expr.c (ffeexpr_nil_rhs_): Double-quote means octal constant.
-	(ffeexpr_token_rhs_): Double-quote means octal constant.
-	* target.h (FFETARGET_defaultIS_VXT_NOT_90): Delete macro
-	definition, no longer needed.
-
-	Make some -ff90 features the default:
-	* data.c (ffedata_value): DATA implies SAVE.
-	* src.h (ffesrc_is_name_noninit): Underscores always okay.
-
-	Fix up some more #error directives by quoting their text:
-	* bld.c (ffebld_constant_is_zero):
-	* target.h:
-
-Sat Jan 18 18:22:09 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* g77.c (lookup_option, main): Recognize `-Xlinker',
-	`-Wl,', `-l', `-L', `--library-directory', `-o',
-	`--output'.
-	(lookup_option): Don't depend on SWITCH_TAKES_ARG
-	being correct, it might or might not have `-x' in
-	it depending on host.
-	Return NULL argument if it would be an empty string.
-	(main): If no input files (by gcc.c's definition)
-	but `-o' or `--output' specified, produce diagnostic
-	to avoid overwriting output via gcc.
-	Recognize C++ `+e' options.
-	Treat -L as another non-magical option (like -B).
-	Don't append_arg `-x' twice.
-
-Fri Jan 10 23:36:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* top.c [BUILT_FOR_270] (ffe_decode_option): Make
-	-fargument-noalias-global the default.
-
-Fri Jan 10 07:42:27 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Enable inlining of previously-compiled program units:
-	* com.c (ffecom_do_entry_, ffecom_start_progunit_):
-	Register new public function in ffeglobal database.
-	(ffecom_sym_transform_): Any GLOBAL or potentially GLOBAL
-	symbol should be looked up in ffeglobal database and
-	that tree node used, if found.  That way, gcc knows
-	the references are to those earlier definitions, so it
-	can emit shorter branches/calls, inline, etc.
-	(ffecom_transform_common_): Minor change for clarity.
-	* expr.c (ffeexpr_sym-lhs_call_, ffeexpr_sym_lhs_extfunc_,
-	ffeexpr_sym_rhs_actualarg_, ffeexpr_paren_rhs_let_,
-	ffeexpr_token_funsubstr_): Globalize symbol as needed.
-	* global.c (ffeglobal_promoted): New function to look up
-	existing local symbol in ffeglobal database.
-	* global.h: Declare new function.
-	* name.h (ffename_token): New macro, plus alphabetize.
-	* stc.c (ffestc_R1207_item): Globalize EXTERNAL symbol.
-	* stu.c (ffestu_sym_end_transition, ffestu_sym_exec_transition):
-	Globalize symbol as needed.
-	* symbol.h, symbol.c (ffesymbol_globalize): New function.
-
-Thu Jan  9 14:20:00 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* ste.c (ffeste_R809): Produce a diagnostic for SELECT CASE
-	on CHARACTER type, instead of crashing.
-
-Thu Jan  9 00:52:45 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* stc.c (ffestc_order_entry_, ffestc_order_format_,
-	ffestc_R1226): Allow ENTRY and FORMAT before IMPLICIT
-	NONE, by having them transition only to state 1 instead
-	of state 2 (which is disallowed by IMPLICIT NONE).
-
-Mon Jan  6 22:44:53 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix AXP bug found by Rick Niles (961201-1.f):
-	* com.c (ffecom_init_0): Undo my 1996-05-14 change, as
-	it is incorrect and prevented easily finding this bug.
-	* target.h [__alpha__] (ffetargetReal1, ffetargetReal2):
-	Use int	instead of long.
-	(ffetarget_cvt_r1_to_rv_, ffetarget_cvt_rv_to_r1_,
-	ffetarget_cvt_r2_to_rv_, ffetarget_cvt_rv_to_r2_):
-	New functions that intercede for callers of
-	REAL_VALUE_(TO|UNTO)_TARGET_(SINGLE|DOUBLE).
-	All callers changed, and damaging casts to (long *) removed.
-
-Sun Jan  5 03:26:11 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in (g77, g77-cross): Depend on both g77.c and
-	zzz.c, in $(srcdir)/f/.
-
-	Better design for -fugly-assumed:
-	* stc.c (ffestc_R501_item, ffestc_R524_item,
-	ffestc_R547_item_object): Pass new is_ugly_assumed flag.
-	* stt.c, stt.h (ffestt_dimlist_as_expr,
-	ffestt_dimlist_type): New is_ugly_assumed flag now
-	controls whether "1" is treated as "*".
-	Don't treat "2-1" or other collapsed constants as "*".
-
-Sat Jan  4 15:26:22 1997  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* stb.c (ffestb_R10012_): Don't confirm on FORMAT(A,)
-	or even FORMAT(A,,B), as R1229 only warns about the
-	former currently, and this seems reasonable.
-
-	Improvements to diagnostics:
-	* sta.c (ffesta_second_): Don't add any ffestb parsers
-	unless they're specifically called for.
-	Set up ffesta_tokens[0] before calling ffestc_exec_transition,
-	else stale info might get used.
-	(ffesta_save_): Do a better job picking which parser to run
-	after running all parsers with no confirmed possibles.
-	(FFESTA_maxPOSSIBLES_): Decrease from 100 now that so few
-	possibles are ever on the list at a given time.
-	(struct _ffesta_possible): Add named attribute.
-	(ffesta_add_possible_exec_, ffesta_add_possible_nonexec_):
-	Make these into macros that call a single function that now
-	sets the named attribute.
-	(ffesta_add_possible_unnamed_exec_,
-	ffeseta_add_possible_unnamed_nonexec_): New macros.
-	(ffesta_second_): Designate unnamed possibles as
-	appropriate.
-	* stb.c (ffestb_R1229, ffestb_R12291_): Use more general
-	diagnostic, so things like "POINTER (FOO, BAR)" are
-	diagnosed as unrecognized statements, not invalid statement
-	functions.
-	* stb.h, stb.c (ffestb_unimplemented): Remove function.
-
-1996-12-30  Dave Love  <d.love@dl.ac.uk>
-
-	* com.c: #include libU77/config.h
-	(ffecom_f2c_ptr_to_integer_type_node,
- 	ffecom_f2c_ptr_to_integer_type_node): New variables.
-	(ffecom_init_0): Use them.
-	(ffecom_expr_intrinsic_): Many news cases for libU77 intrinsics.
-
-	* com-rt.def: New definitions for libU77.
-	* intrin.def: Likewise.  Also correct ftell arg spec.
-
-	* Makefile.in (f/runtime/libU77/config.h): New target for com.c
- 	dependency.
-	* Make-lang.in (f771): Depend on f/runtime/Makefile for the above.
-
-Sat Dec 28 12:28:29 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* stt.c (ffestt_dimlist_type): 	Treat ([...,]1) in dimlist
-	as ([...,]*) if -fugly-assumed, so assumed-size array
-	detected early enough.
-
-Thu Dec 19 14:01:57 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* target.h (FFETARGET_REAL_VALUE_FROM_INT_): Conditionalize
-	definition on BUILT_FOR_280, not BUILT_WITH_280, since
-	the name of the macro was (properly) changed since 0.5.19.
-
-	Fix warnings/errors resulting from ffetargetOffset becoming
-	`long long int' instead of `unsigned long' as of 0.5.19,
-	while ffebitCount remains `unsigned long':
-	* bld.c (ffebld_constantarray_dump): Avoid warnings by
-	using loop var of appropriate type, and using casts.
-	* com.c (ffecom_expr_): Use right type for loop var.
-	(ffecom_sym_transform_, ffecom_transform_equiv_):
-	Cast to right type in assertions.
-	* data.c (ffedata_gather_, ffedata_value_): Cast to right
-	type in assertions and comparisons.
-
-Wed Dec 18 12:07:11 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Patch from Alexandre Oliva <oliva@dcc.unicamp.br>:
-	* Makefile.in (all.indirect): Don't pass -bbigtoc option
-	to GNU ld.
-
-	Cope with new versions of gcc:
-	* com.h (BUILT_FOR_280): New macro.
-	* com.c (ffecom_ptr_to_expr): Conditionalize test of
-	OFFSET_REF.
-	(ffecom_build_complex_constant_): Conditionalize calling
-	sequence for build_complex.
-
-Sat Dec  7 07:15:17 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Version 0.5.19 released.
-
-Fri Dec  6 12:23:55 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* g77.c: Default to assuming "f77" is in $LANGUAGES, since
-	the LANGUAGE_F77 macro isn't defined by anyone anymore (but
-	might as well leave the no-f77 code in just in case).
-	* Make-lang.in (g77, g77-cross): Don't define LANGUAGE_F77
-	anymore.
-
-1996-12-06  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (g77, g77-cross): Revert to building `g77' or not
-	conditional on `f77' in LANGUAGES.
-
-Wed Dec  4 13:08:44 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in (g77, g77-cross): No libs or lib dependencies
-	in case where "f77" is not in $LANGUAGES.
-
-	* lex.c (ffelex_image_char_, ffelex_file_fixed,
-	ffelex_file_free): Fixes to properly handle lines with
-	null character, and too-long lines as well.
-
-	* lex.c: Call ffebad_start_msg_lex instead of
-	ffebad_start_msg throughout.
-
-Sun Dec  1 21:19:55 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Fix-up for 1996-11-25 changes:
-	* com.c (ffecom_member_phase2_): Subtract out 0 offset for
-	elegance and consistency with EQUIVALENCE aggregates.
-	(ffecom_sym_transform_): Ditto for LOCAL/COMMON, and
-	ensure we get the same parent storage area.
-	* data.c (ffedata_gather_, ffedata_value_): Subtract out
-	aggregate offset.
-
-Wed Nov 27 13:55:57 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* proj.h: Quote the text of the #error message, to avoid
-	strange-looking diagnostics from non-gcc ANSI compilers.
-
-	* top.c: Make -fno-debug-kludge the default.
-
-Mon Nov 25 20:13:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Provide more info on EQUIVALENCE mismatches:
-	* bad.def (FFEBAD_EQUIV_MISMATCH): More detailed message.
-	* equiv.c (ffeequiv_layout_local_, ffeequiv_layout_cblock):
-	More details for FFEBAD_EQUIV_MISMATCH.
-
-	Fix problem with EQUIVALENCE handling:
-	* equiv.c (ffeequiv_layout_local_): Redesign algorithm --
-	old one was broken, resulting in rejection of good code.
-	(ffeequiv_offset_): Add argument, change callers.
-	Clean up the code, fix up the (probably unused) negative-value
-	case for SYMTER.
-	* com.c (ffecom_sym_transform_): For local EQUIVALENCE
-	member, subtract out aggregate offset (which is <= 0).
-
-Thu Nov 21 12:44:56 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Change type of ffetargetOffset from `unsigned long' to `long long':
-	* bld.c (ffebld_constantarray_dump): Change printf formats.
-	* storag.c (ffestorag_dump): Ditto.
-	* symbol.c (ffesymbol_report): Ditto.
-	* target.h (ffetargetOffset_f): Ditto and change type itself.
-
-	Handle situation where list of languages does not include f77:
-	* Make-lang.in: Define LANGUAGE_F77 to 1 only if `f77' is in
-	the $LANGUAGES macro for the build.
-	* g77.c: Compile to a (nearly) no-op program if LANGUAGE_F77
-	is not defined to 1.
-
-	Fixes to delay confirmation of READ, WRITE, and GOTO statements
-	so the corresponding assignments to same-named CHAR*(*) arrays
-	work:
-	* stb.c (ffestb_R90915_, ffestb_91014_): New functions.
-	(ffestb_goto3_, ffestb_goto5_): Move confirmation from 3 to 5
-	for the OPEN_PAREN case.
-	(ffestb_R9091_, ffestb_R9094_, ffestb_R90913_, ffestb_R90914_,
-	ffestb_R91012_, ffestb_R91013_): Use new functions, and confirm
-	except for the OPEN_PAREN case.
-
-	Fixes to not confirm declarations with an open paren where
-	an equal sign or other assignment-like token might be, so the
-	corresponding assignments to same-named CHAR*(*) arrays work:
-	(ffestb_decl_entsp_5_): Move assertion so we crash on that first,
-	if it turns out to be wrong, before the less-debuggable crash
-	on mistaken confirmation.
-	(ffestb_decl_entsp_6_, ffestb_decl_entsp_7_, ffestb_decl_entsp_8_):
-	Include OPEN_PAREN in list of assignment-only tokens.
-
-	Fix more diagnosed-crash bugs:
-	* stu.c (ffestu_sym_end_transition): ANY-ize an adjustable array
-	with bad dimension expressions even if still stateUNCERTAIN.
-	(ffestu_symter_end_transition_, ffestu_symter_exec_transition_):
-	Return TRUE for opANY as well.
-	For code elegance, move opSYMTER case into first switch.
-
-1996-11-17  Dave Love  <d.love@dl.ac.uk>
-
-	* lex.c: Fix last change.
-
-1996-11-14  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in, config-lang.in: Remove the (broken) libU77 stuff,
-	pending 0.5.20.
-
-Thu Nov 14 15:40:59 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* bad.def (FFEBAD_UNIMPL_STMT): Explain that invalid
-	intrinsic references can trigger this message, too.
-
-1996-11-12  Dave Love  <d.love@dl.ac.uk>
-
-        * lex.c: Declare dwarfout routines.
-
-        * config-lang.in: Sink grep o/p.
-
-Mon Nov 11 14:21:13 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* g77.c (main): Might as well print version number
-	for --verbose as well.
-
-Thu Nov  7 18:41:41 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c, lang-options.h, target.h, top.c, top.h: Split out
-	remaining -fugly stuff into -fugly-logint and -fugly-comma,
-	leaving -fugly as simply a `macro' that expands into other
-	options, and eliminate defaults for some of the ugly stuff
-	in target.h.
-
-	* Make-lang.in (gcc-cross): Compile zzz.c, not version.o (!),
-	in to get version info for this target.
-
-	* config-lang.in: Test for GBE patch application based
-	on whether 2.6.x or 2.7.x GBE is detected.
-
-Wed Nov  6 14:19:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in (g77): Compile zzz.c in to get version info.
-	* g77.c: Add support for --help and --version.
-
-	* g77.c (lookup_option): Short-circuit long-winded tests
-	when second char is not hyphen, just to save a spot of time.
-
-Sat Nov  2 13:50:31 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* intrin.def: Add FTELL and FSEEK intrinsics, plus new
-	`g' codes for alternate-return (GOTO) arguments.
-	* intrin.c (ffeintrin_check_): Support `g' codes.
-	* com-rt.def: Add ftell_() and fseek_() to database.
-	* com.c (ffecom_expr_intrinsic_): Ditto.  Also, let each
-	subroutine intrinsic decide for itself what to do with
-	tree_type, the default being NULL_TREE once again (so
-	ffecom_call_ doesn't think it's supposed to cast the
-	function call to the type in the fall-through case).
-
-	* ste.c (ffeste_R909_finish): Don't special-case list-directed
-	I/O, now that libf2c can return nonzero status codes.
-	(ffeste_R910_finish): Ditto.
-	(ffeste_io_call_): Simplify logic.
-	(ffeste_io_impdo_):
-	(ffeste_subr_beru_):
-	(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_R923A): Ditto all the above.
-
-Thu Oct 31 20:56:28 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* config-lang.in, Make-lang.in: Rename flag file
-	build-u77 to build-libu77, for consistency with
-	install-libf2c and such.
-
-	* config-lang.in: Don't complain about failure to patch
-	if pre-2.7.0 gcc is involved (since our patch for that
-	doesn't add support for tooning).
-
-Sat Oct 26 05:56:51 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* bad.def (FFEBAD_TYPELESS_TOO_LARGE): Remove this
-	unused and redundant diagnostic.
-
-Sat Oct 26 00:45:42 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* target.c (ffetarget_integerhex): Fix dumb bug.
-
-1996-10-20  Dave Love  <d.love@dl.ac.uk>
-
-	* gbe/2.7.2.1.diff: New file.
-
-	* Makefile.in (F771_LDFLAGS): Add -bbigtoc for AIX4.1 up, suggested by
-	endo@material.tohoku.ac.jp [among others!].
-
-Sat Oct 19 03:11:14 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* bad.def, bld.c, bld.h, expr.c, lang-options.h, target.c,
-	target.h, top.c, top.h (ffebld_constant_new_integerbinary,
-	ffebld_constant_new_integerhex, ffebld_constant_new_integeroctal,
-	ffeexpr_token_name_apos_name_, ffetarget_integerbinary,
-	ffetarget_integerhex, ffetarget_integeroctal): Support
-	new -fno-typeless-boz option with new functions, mods to
-	existing octal-handling functions, new macros, new error
-	messages, and so on.
-
-	* com.c, lang-options.h, top.c, top.h (ffecom_notify_primary_entry):
-	Print program unit name on stderr if -fno-silent (new option).
-
-	* lang-options.h, top.c, top.h, stt.c (ffestt_dimlist_as_expr):
-	Treat ([...,]1) in dimlist as ([...,]*) if -fugly-assumed
-	(new option).
-
-	* lang-options.h: Comment out options duplicated in gcc/toplev.c,
-	because, somehow, having them commented in and building on my
-	DEC Alpha results in a cc1 that always segfaults, and gdb that
-	also segfaults whenever it debugs it up to init_lex() calling
-	xmalloc() or so.
-
-Thu Oct 17 00:39:27 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* stb.c (ffestb_R10013_): Don't change meaning of .sign until
-	after previous meaning/value used to set sign of value
-	(960507-1.f).
-
-Sun Oct 13 22:15:23 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* top.c (ffe_decode_option): Don't set back-end flags
-	that are nonexistent prior to gcc 2.7.0.
-
-Sun Oct 13 12:48:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (convert): Don't convert emulated complex expr to
-	real (via REALPART_EXPR) if the target type is (emulated)
-	complex.
-
-Wed Oct  2 21:57:12 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_debug_kludge_): Set DECL_IN_SYSTEM_HEADER so
-	-Wunused doesn't complain about these manufactured decls.
-	(ffecom_expr_): Ditto, for original (non-ASSIGN'ed) variable.
-	(ffecom_transform_equiv_): Clear DECL_IGNORED_P for aggregate
-	area so it shows up as a debug-accessible symbol.
-	(pushdecl): Default for "invented" identifiers (a g77-specific
-	concept for now) is that they are artificial, in system header,
-	ignored for debugging purposes, used, and (for types) suppressed.
-	This ought to be overkill.
-
-Fri Sep 27 23:13:07 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* ste.c (ffeste_begin_iterdo_, ffeste_end_iterdo_): Support
-	one-trip DO loops (F66-style).
-	* lang-options.h, top.c, top.h (-fonetrip): New option.
-
-Thu Sep 26 00:18:40 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_debug_kludge_): New function.
-	(ffecom_sym_transform_): Use new function for COMMON and EQUIVALENCE
-	members.
-
-	* lang-options.h, top.c, top.h (-fno-debug-kludge):
-	New option.
-
-1996-09-24  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (include/f2c.h):
-	Remove dependencies on xmake_file and tmake_file.
-	They expand inconsistently in 2.8 c.f. 2.7; $(GCC_PARTS) depends on
-	them anyhow.
-
-1996-09-22  Dave Love  <d.love@dl.ac.uk>
-
-	* config-lang.in: Add --enable-libu77 option handling.
-
-	* Make-lang.in:
-	Conditionally add --enable-libu77 when running runtime configure.
-	Define LIBU77STAGESTUFF and use it in relevant rules.
-
-1996-08-21  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (f77-runtime):
-	`stmp-hdrs' should have been `stmp-headers'.
-
-1996-08-20  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (f77-runtime):
-	Depend on stmp-hdrs, not stmp-int-hdrs, since libF77
-	needs float.h.
-
-Sat Jun 22 18:17:11 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_tree_divide_): Fix RECORD_TYPE case to
-	look at type of first field, properly, to determine
-	whether to call c_div or z_div.
-
-Tue Jun  4 04:27:18 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_build_complex_constant_): Explicitly specify
-	TREE_PURPOSE.
-	(ffecom_expr_): Fix thinko.
-	(ffecom_2): For COMPLEX_EXPR, explicitly specify TREE_PURPOSE.
-
-Mon May 27 16:23:43 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Changes to optionally avoid gcc's back-end complex support:
-	* com.c (ffecom_stabilize_aggregate_): New function.
-	(ffecom_convert_to_complex_): New function.
-	(ffecom_make_complex_type_): New function.
-	(ffecom_build_complex_constant_): New function.
-	(ffecom_expr_): For opCONVERT of non-COMPLEX to COMPLEX,
-	don't bother explicitly converting to the subtype first,
-	because gcc does that anyway, and more code would have
-	to be added to find the subtype for the emulated-complex
-	case.
-	(ffecom_f2c_make_type_): Use ffecom_make_complex_type_
-	instead of make_node etc. to make a complex type.
-	(ffecom_1, ffecom_2): Translate operations on COMPLEX operands
-	to appropriate operations when emulating complex.
-	(ffecom_constantunion): Use ffecom_build_complex_constant_
-	instead of build_complex to build a complex constant.
-	(ffecom_init_0): Change point at which types are laid out
-	for improved consistency.
-	Use ffecom_make_complex_type_ instead of make_node etc.
-	to make a complex type.
-	Always calculate storage sizes from TYPE_SIZE, never TYPE_PRECISION.
-	(convert): Use e, not expr, since we've copied into that anyway.
-	For RECORD_TYPE cases, do emulated-complex conversions.
-	(ffecom_f2c_set_lio_code_): Always calculate storage sizes
-	from TYPE_SIZE, never TYPE_PRECISION.
-	(ffecom_tree_divide_): Allow RECORD_TYPE to also be handled
-	by run-time library.
-	(ffecom_expr_intrinsic_): Handle possible RECORD_TYPE as argument
-	to AIMAG intrinsic.
-
-	* top.h, top.c, lang-options.h: Support new -f(no-)emulate-complex option.
-
-	* com.c (ffecom_sym_transform_): Clarify and fix typos in comments.
-
-Mon May 20 02:06:27 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* target.h: Use new REAL_VALUE_UNTO_TARGET_* macros instead
-	of REAL_VALUE_FROM_TARGET_DOUBLE and _SINGLE.
-	Explicitly use long instead of HOST_WIDE_INT for emulation
-	of ffetargetReal1 and ffetargetReal2.
-
-1996-05-20  Dave Love  <d.love@dl.ac.uk>
-
-	* config-lang.in:
-	Test for patch being applied with flag_move_all_movables in toplev.c.
-
-	* install.texi (Patching GNU Fortran):
-	Mention overriding X_CFLAGS rather than
-	editing proj.h on SunOS4.
-
-	* Make-lang.in (F77_FLAGS_TO_PASS):
-	Add X_CFLAGS (convenient for SunOS4 kluge, in
-	particular).
-	(f77.{,mostly,dist}clean): Reorder things, in particular not to delete
-	Makefiles too early.
-
-	* g77.c (DEFAULT_SWITCH_TAKES_ARG): Define a la gcc.c in the
-	current GCC snapshot.
-
-Tue May 14 00:24:07 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	Changes for DEC Alpha AXP support:
-	* com.c (ffecom_init_0): REAL_ARITHMETIC means internal
-	REAL/DOUBLE PRECISION might well have a different size
-	than the compiled type, so don't crash if this is the
-	case.
-	* target.h: Use `int' for ffetargetInteger1,
-	ffetargetLogical1, and magical tests.  Set _f format
-	strings accordingly.
-
-Tue Apr 16 14:08:28 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* top.c (ffe_decode_option): -Wall no longer implies
-	-Wsurprising.
-
-Sat Apr 13 14:50:06 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_char_args_): If item is error_mark_node,
-	set *length that way, too.
-
-	* com.c (ffecom_expr_power_integer_): If either operand
-	is error_mark_node, return that.
-
-	* com.c (ffecom_intrinsic_len_): If item is error_mark_node,
-	return that for length.
-
-	* expr.c (ffeexpr_declare_unadorned_,
-	ffeexpr_declare_parenthesized_): Instead of crashing
-	on unexpected contexts, produce a diagnostic.
-
-	* intrin.c (ffeintrin_check_), intrin.def (impSIGNAL):
-	Allow procedure as second arg to SIGNAL intrinsic.
-
-	* stu.c (ffestu_symter_end_transition_): New function.
-	(ffestu_symter_exec_transition_): Return bool arg.
-	Always transition symbol (don't inhibit when !whereNONE).
-	(ffestu_sym_end_transition): If DUMMY/LOCAL arg has any
-	opANY exprs in its dimlist, diagnose it so it doesn't
-	make it through to later stages that try to deal with
-	dimlist stuff.
-	(ffestu_sym_exec_transition): If sym has any opANY exprs
-	in its dimlist, diagnose it so it becomes opANY itself.
-
-	* symbol.c (ffesymbol_error): If token arg is NULL,
-	just ANY-ize the symbol -- don't produce diagnostic.
-
-Mon Apr  1 10:14:02 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Version 0.5.18 released.
-
-Mon Mar 25 20:52:24 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_expr_power_integer_): Don't generate code
-	that compares COMPLEX (or, as it happens, REAL) via "LT_EXPR",
-	since the back end crashes on that.  (This code would never
-	be executed anyway, but the test that avoids it has now been
-	translated to control whether the code gets generated at all.)
-	Fixes 960323-3.f.
-
-	* com.c (ffecom_type_localvar_): Handle variable-sized
-	dimension bounds expressions here, so they get calculated
-	and saved on procedure entry.  Fixes 960323-4.f.
-
-	* com.c (ffecom_notify_init_symbol): Symbol has no init
-	info at all if only zeros have been used to initialize it.
-	Fixes 960324-0.f.
-
-	* expr.c, expr.h (ffeexpr_type_combine): Renamed from
-	ffeexpr_type_combine_ and now a public procedure; last arg now
-	a token, instead of an internal structure used to extract a token.
-	Now allows the outputs to be aliased with the inputs.
-	Now allows a NULL token to mean "don't report error".
-	(ffeexpr_reduced_bool2_, ffeexpr_reduced_eqop2_,
-	ffeexpr_reduced_math2_, ffeexpr_reduced_power_,
-	ffeexpr_reduced_relop2_): Handle new calling sequence for
-	ffeexpr_type_combine.
-	* (ffeexpr_convert): Don't put an opCONVERT node
-	in just because the size is unknown; all downstream code
-	should be able to deal without it being there anyway, and
-	getting rid of it allows new intrinsic code to more easily
-	combine types and such without generating bad code.
-	* info.c, info.h (ffeinfo_kindtype_max): Rewrite to do
-	proper comparison of size of types, not just comparison
-	of their internal kind numbers (so I2.eq.I1 doesn't promote
-	I1 to I2, rather the other way around).
-	* intrin.c (ffeintrin_check_): Combine types of arguments
-	in COL a la expression handling, for greater flexibility
-	and permissiveness (though, someday, -fpedantic should
-	report use of this kind of thing).
-	Make sure Hollerith/typeless where CHARACTER expected is
-	rejected.  This all fixes 960323-2.f.
-
-	* ste.c (ffeste_begin_iterdo_): Fix some more type conversions
-	so INTEGER*2-laden DO loops don't crash at compile time on
-	certain machines.  Believed to fix 960323-1.f.
-
-	* stu.c (ffestu_sym_end_transition): Certainly reject
-	whereDUMMY not in any dummy list, whether stateUNCERTAIN
-	or stateUNDERSTOOD.  Fixes 960323-0.f.
-
-Tue Mar 19 13:12:40 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* data.c (ffedata_value): Fix crash on opANY, and simplify
-	the code at the same time.
-
-	* Make-lang.in (f77-runtime): Also depends on lib[FI]77/Makefile...
-	(include/f2c.h...): ...which in turn depend on */Makefile.in.
-	(f77.rebuilt): Rebuild runtime stuff too.
-
-	* intrin.c (ffeintrin_check_): Accommodate TYPELESS/HOLLERITH
-	types, convert args as necessary, etc.
-
-	* expr.c (ffeexpr_convert): Fix test for TYPELESS/HOLLERITH
-	to obey the docs; crash if no source token when error.
-	(ffeexpr_collapse_convert): Crash if no token when error.
-
-Mon Mar 18 15:51:30 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_init_zero_): Renamed from
-	ffecom_init_local_zero_; now handles top-level
-	(COMMON) initializations too.
-
-	* bld.c (ffebld_constant_is_zero):
-	* com.c (ffecom_symbol_transform_, ffecom_sym_transform_assign_,
-	ffecom_transform_common_, ffecom_transform_equiv_):
-	* data.c:
-	* equiv.c:
-	* equiv.h:
-	* lang-options.h:
-	* stc.c:
-	* storag.c:
-	* storag.h:
-	* symbol.c:
-	* symbol.h:
-	* target.c:
-	* target.h:
-	* top.c:
-	* top.h: All of this is mostly housekeeping-type changes
-	to support -f(no-)zeros, i.e. not always stuff zero
-	values into the initializer fields of symbol/storage objects,
-	but still track that they have been given initial values.
-
-	* bad.def: Fix wording for DATA-related diagnostics.
-
-	* com.c (ffecom_sym_transform_assign_): Don't check
-	any EQUIVALENCE stuff for local ASSIGN, the check was
-	bad (crashing), and it's not necessary, anyway.
-
-	* com.c (ffecom_expr_intrinsic_): For MAX and MIN,
-	ignore null arguments as far arg[123], and fix handling
-	of ANY arguments.  (New intrinsic support now allows
-	spurious trailing null arguments.)
-
-	* com.c (ffecom_init_0): Add HOLLERITH (unsigned)
-	equivalents for INTEGER*2, *4, and *8, so shift intrinsics
-	and other things that need unsigned versions of signed
-	types work.
-
-Sat Mar 16 12:11:40 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* storag.c (ffestorag_exec_layout): Treat adjustable
-	local array like dummy -- don't create storage object.
-	* com.c (ffecom_sym_transform_): Allow for NULL storage
-	object in LOCAL case (adjustable array).
-
-Fri Mar 15 13:09:41 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_sym_transform_): Allow local symbols
-	with nonconstant sizes (adjustable local arrays).
-	(ffecom_type_localvar_): Allow dimensions with nonconstant
-	component (adjustable local arrays).
-	* expr.c: Various minor changes to handle adjustable
-	local arrays (a new case of stateUNCERTAIN).
-	* stu.c (ffestu_sym_end_transition,
-	ffestu_sym_exec_transition): Ditto.
-	* symbol.def: Update docs to reflect these changes.
-
-	* com.c (ffecom_expr_): Reduce space/time needed for
-	opACCTER case by handling it here instead of converting
-	it to opARRTER earlier on.
-	(ffecom_notify_init_storage): Don't convert ACCTER to ARRTER.
-	(ffecom_notify_init_symbol): Ditto.
-
-	* com.c (ffecom_init_0): Crash and burn if any of the types'
-	sizes, according to the GBE, disagrees with the sizes of
-	the FFE's internal implementation.  This might catch
-	Alpha/SGI bugs earlier.
-
-Fri Mar 15 01:09:41 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com-rt.def, com.c, com.h: Changes for rewrite of intrinsic
-	handling.
-	* com.c (ffecom_arglist_expr_): New function.
-	(ffecom_widest_expr_type_): New function.
-	(ffecom_expr_intrinsic_): Reorganize, some rewriting.
-	(ffecom_f2c_make_type_): Layout complex types.
-	(ffecom_gfrt_args_): New function.
-	(ffecom_list_expr): Trivial change for consistency.
-
-	* expr.c (ffeexpr_token_name_rhs_): Go back to getting
-	type from specific, not implementation, info.
-	(ffeexpr_token_funsubstr_): Set intrinsic implementation too!
-	* intrin.c: Major rewrite of most portions.
-	* intrin.def: Major rearchitecting of tables.
-	* intrin.h (ffeintrin_basictype, ffeintrin_kindtype):
-	Now (once again) take ffeintrinSpec as arg, not ffeintrinImp;
-	for now, these return NONE, since they're not really needed
-	and adding the necessary info to the tables is not trivial.
-	(ffeintrin_codegen_imp): New function.
-	* stc.c (ffestc_R1208_item): Change way ffeintrin funcs called,
-	back to original per above; but comment out the code anyway.
-
-	* intrin.c (ffe_init_0): Do internal checks only if
-	-fset-g77-defaults not specified.
-
-	* lang-options.h: Add -fset-g77-defaults option.
-	* lang-specs.h: Always pass -fset-g77-defaults.
-	* top.c, top.h: New option.
-
-Sat Mar  9 17:49:50 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in (stmp-int-hdrs): Use --no-validate when
-	generating the f77.rebuilt files (BUGS, INSTALL, NEWS)
-	so cross-references can work properly in g77.info
-	without a lot of hassle.  Users can probably deal with
-	the way they end up looking in the f77.rebuilt files.
-
-	* bld.c (ffebld_constant_new_integer4_val): INTEGER*8
-	support -- new function.
-	(ffebld_constant_new_logical4_val): New function.
-	* com.c (ffecom_f2c_longint_type_node): New type.
-	(FFECOM_rttypeLONGINT_): New return type code.
-	(ffecom_expr_): Add code to invoke pow_qq instead
-	of pow_ii for INTEGER4 (INTEGER*8) case.
-	If ffecom_expr_power_integer_ returns NULL_TREE, just do
-	the usual work.
-	(ffecom_make_gfrt_): Handle new type.
-	(ffecom_expr_power_integer_): Let caller do the work if in
-	dummy-transforming case, since
-	caller now knows about INTEGER*8 and such, by returning
-	NULL_TREE.
-	* expr.c (ffeexpr_reduced_power_): Complain about non-INTEGER
-	raised to INTEGER4 (INTEGER*8) power.
-
-	* target.c (ffetarget_power_integerdefault_integerdefault):
-	Fix any**negative.
-	* com.c (ffecom_expr_power_integer_): Fix (-1)**(-8) and similar
-	to ABS() the integral result if the exponent is negative
-	and even.
-
-	* ste.c (ffeste_begin_iterdo_): Clean up a type ref.
-	Always convert iteration count to _default_ INTEGER.
-
-	* sta.c (ffesta_second_): Add BYTE and WORD type/stmts;
-	changes by Scott Snyder <snyder@d0sgif.fnal.gov>.
-	* stb.c (ffestb_decl_recursive): Ditto.
-	(ffestb_decl_recursive): Ditto.
-	(ffestb_decl_entsp_2_): Ditto.
-	(ffestb_decl_entsp_3_): Ditto.
-	(ffestb_decl_funcname_2_): Ditto.
-	(ffestb_decl_R539): Ditto.
-	(ffestb_decl_R5395_): Ditto.
-	* stc.c (ffestc_establish_declstmt_): Ditto.
-	* std.c (ffestd_R539item): Ditto.
-	(ffestd_R1219): Ditto.
-	* stp.h: Ditto.
-	* str-1t.fin: Ditto.
-	* str-2t.fin: Ditto.
-
-	* expr.c (ffeexpr_finished_): For DO loops, allow
-	any INTEGER type; convert LOGICAL (assuming -fugly)
-	to corresponding INTEGER type instead of always default
-	INTEGER; let later phases do conversion of DO start,
-	end, incr vars for implied-DO; change checks for non-integral
-	DO vars to be -Wsurprising warnings.
-	* ste.c (ffeste_io_impdo_): Convert start, end, and incr
-	to type of DO variable.
-
-	* com.c (ffecom_init_0): Add new types for [IL][234],
-	much of which was done by Scott Snyder <snyder@d0sgif.fnal.gov>.
-	* target.c: Ditto.
-	* target.h: Ditto.
-
-Wed Mar  6 14:08:45 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* top.c (ffe_init_gbe_): Make -frerun-loop-opt the default.
-
-Mon Mar  4 12:27:00 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_exprstack_push_unary_): Really warn only
-	about two successive _arithmetic_ operators.
-
-	* stc.c (ffestc_R522item_object): Allow SAVE of (understood)
-	local entity.
-
-	* top.c (ffe_decode_option): New -f(no-)second-underscore options.
-	* top.h: New options.
-	* com.c (ffecom_get_external_identifier_, ffecom_get_identifier_):
-	New options.
-
-	* Make-lang.in (f77.maintainer-clean): Clean f/BUGS, f/INSTALL,
-	f/NEWS.
-	($(srcdir)/f/BUGS, $(srcdir)/f/INSTALL, $(srcdir)/f/NEWS):
-	New rules.
-	($(srcdir)/f/g77.info, $(srcdir)/f/g77.dvi): Depend on
-	f/bugs.texi and f/news.texi.
-	(f77.install-man): Install f77 man pages (if enabled).
-	(f77.uninstall): Uninstall info docs, f77 man pages (if enabled).
-
-	* top.c (ffe_init_gbe_): New function.
-	(ffe_decode_option, ffe_file): Call ffe_init_gbe_ to
-	set defaults for gcc options.
-
-Sat Jan 20 13:57:19 1996  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_get_identifier_): Eliminate needless
-	comparison of results of strchr.
-
-Tue Dec 26 11:41:56 1995  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* Make-lang.in: Add rules for new files g77.texi, g77.info,
-	and g77.dvi.
-	Reorganize the *clean rules to more closely parallel gcc's.
-
-	* config-lang.in: Exclude g77.info from diffs.
-
-Sun Dec 10 02:29:13 1995  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* expr.c (ffeexpr_declare_unadorned_,
-	ffeexpr_declare_parenthesized_): Break out handling of
-	contextDATAIMPDO[INDEX,CTRL] so it's independent of symbol state.
-	Don't exec-transition these here (let ffeexpr_sym_impdoitem_
-	handle that when appropriate).  Don't "declare" them twice.
-
-Tue Dec  5 06:48:26 1995  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* stc.c (ffestc_promote_sfdummy_): Allow whereNONE parent
-	symbol, since it is not necessarily known whether it will
-	become LOCAL or DUMMY.
-
-Mon Dec  4 03:46:55 1995  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* lex.c (ffelex_display_token, ffelex_type_string_): Resurrect
-	these from their old versions and update them for possible invocation
-	from debugger.
-	* lex.h (ffelex_display_token): Declare this in case anyone
-	else wants to call it.
-
-	* lex.c (ffelex_total_tokens_): Have this reflect actual allocated
-	tokens, no longer include outstanding "uses" of tokens.
-
-	* malloc.c, malloc.h (MALLOC_DEBUG): New macro to control
-	checking of whether callers follow rules, now defaults to 0
-	for "no checking" to improve compile times.
-
-	* malloc.c (malloc_pool_kill): Fix bug that could prevent
-	subpool from actually being killed (wasn't setting its use
-	count to 1).
-
-	* proj.h, *.c (dmpout): Replace all occurrences of `stdout'
-	and some of `stderr' with `dmpout', so where to dump debugging
-	output can be easily controlled during build; add default
-	for `dmpout' of `stderr' to proj.h.
-
-Sun Dec  3 00:56:29 1995  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* com.c (ffecom_return_expr): Eliminate attempt at warning
-	about unset return values, since the back end does this better,
-	with better wording, and is not triggered by clearly working
-	(but spaghetti) code as easily as this test.
-
-Sat Dec  2 08:28:56 1995  Craig Burley  <burley@gnu.ai.mit.edu>
-
-	* target.c (ffetarget_power_*_integerdefault): Raising 0 to
-	integer constant power should not be an error condition;
-	if so, other code should catch 0 to any power, etc.
-
-	* bad.def (FFEBAD_BAD_POWER): 0**integer now a warning instead
-	of an error.
-
-Fri Dec  1 00:12:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bad.def: Clarify diagnostic regarding complex constant elements.
-	* expr.c (ffeexpr_cb_comma_c_): Capitalize real/imaginary
-	for clarified diagnostic.
-
-	* com.c (ffecom_close_include_): Close the file!
-
-	* lex.c (ffelex_file_fixed): Update line info if the line
-	has any content, not just if it finishes a previous line
-	or has a label.
-	(ffelex_file_free): Clarify switch statement code.
-
-Sat Nov 18 19:37:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.17 released.
-
-Fri Nov 17 14:27:24 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Make-lang.in: Fix typo in comment.
-
-	* Makefile.in (f/fini.o, f/proj-h.o): Don't use `$<' since
-	not all makes support it (e.g. NeXT make), use explicit
-	source name instead (with $(srcdir) and munging).
-	(ASSERT_H): assert.h lives in source dir, not build dir.
-
-Thu Nov 16 12:47:50 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_init_0): Fix dumb bug in code to produce
-	warning message about non-32-bit-systems.
-
-	* stc.c (ffestc_R501_item): Parenthesize test to make
-	warning go away (and perhaps fix bug).
-
-Thu Nov 16 03:43:33 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* g77.c: Upgrade to 2.7.0's gcc.c.
-	Fix -v to pass a temp name instead of "/dev/null" for "-o".
-
-Fri Nov 10 19:16:05 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* ste.c (ffeste_begin_iterdo_): Add Toon's change to
-	make loops faster on some machines (implement termination
-	condition as "--i >= 0" instead of "i-- > 0").
-
-Thu Nov  2 03:58:17 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Make-lang.in: Remove unnecessary $(exeext) a la cp/Make-lang.in.
-
-	* com.c (ffecom_expr_): Restore old strategy for assignp variant
-	of opSYMTER case...always return the ASSIGN version of var.
-	That way, `-O -Wuninitialized' will catch "I=3;GOTO I;END"
-	(though the diagnostic will refer to `__g77_ASSIGN_i').
-
-	* com.c (ffecom_expr_power_integer_): For constant rhs case,
-	wrap every new eval of lhs in save_expr() so it is clear to
-	back end that MULT_EXPR(lhs,lhs) has identical operands,
-	otherwise for an rhs like 32767 it generates around 65K pseudo
-	registers, with which stupid_life_analysis cannot cope
-	(due to reg_renumber in regs.h being `short *' instead of
-	`int *').
-
-	* com.c (ffecom_expr_): Speed up implementation of LOGICAL
-	versions of opNOT, opAND, opOR, opXOR/opNEQV, and opEQV by
-	assuming the values actually are kosher LOGICAL bit patterns.
-	Also simplify code that implements some of the INTEGER versions
-	of these.
-
-	* com.c (skip_redundant_dir_prefix, read_name_map,
-	ffecom_open_include_, signed_type, unsigned_type): Fold in
-	changes to cccp.c made from 2.7.0 through ss-950826.
-
-	* equiv.c (ffeequiv_layout_local_): Kill the equiv list
-	if no syms in list.
-
-	* expr.c (ffeexpr_reduced_eqop2_): Issue specific diagnostic
-	regarding usage of .EQV./.NEQV. in preference to .EQ./.NE..
-
-	* intrin.c: Add ERF and ERFC as generic intrinsics.
-	intrin.def: Same.
-
-	* sta.c (ffesta_save_, ffesta_second_): Whoever calls
-	ffestd_exec_begin must also set ffesta_seen_first_exec = TRUE,
-	and anytime stc sees an exec transition, it must do both.
-	stc.c (ffestc_eof): Same.
-
-	* stc.c (ffestc_promote_sfdummy_): If failed implicit typing
-	or CHARACTER*(*) arg, after calling ffesymbol_error, don't
-	reset info to ENTITY/DUMMY, because ffecom_sym_transform_
-	doesn't expect such a thing with ANY/ANY type.
-
-	* target.h (*logical*): Change some of these so they parallel
-	changes in com.c, e.g. for _eqv_, use (l)==(r) instead of
-	!!(l)==!!(r), to get a more faithful result.
-
-Fri Oct 27 07:06:59 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_sym_transform_): Simplify code for local
-	EQUIVALENCE case.
-
-	* expr.c (ffeexpr_exprstack_push_unary_): Warn about two
-	successive operators.
-	(ffeexpr_exprstack_push_binary_): Warn about "surprising"
-	operator precedence, as in "-2**2".
-
-	* lang-options.h: Add -W(no-)surprising options.
-
-	* parse.c (yyparse): Don't reset -fpedantic if not -pedantic.
-
-	* top.c (ffe_decode_option): Support new -Wsurprising option.
-	* top.h: Ditto.
-
-Mon Oct 23 09:14:15 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_finish_symbol_transform_): Don't transform
-	NONE/NONE (CHARACTER*(*)) vars, as these don't mean anything
-	in debugging terms, and can't be turned into anything
-	in the back end (so ffecom_sym_transform_ crashes on them).
-
-	* com.c (ffecom_expr_): Change strategy for assignp variant
-	of opSYMTER case...always return the original var unless
-	it is not wide enough.
-
-	* ste.c (ffeste_io_cilist_): Clarify diagnostic for ASSIGN
-	involving too-narrow variable.  This shouldn't happen, though.
-	(ffeste_io_icilist_): Ditto.
-	(ffeste_R838): Ditto.
-	(ffeste_R839): Ditto.
-
-Thu Oct 19 03:21:20 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_sym_transform_assign_): Set TREE_STATIC
-	using the same decision-making process as used for their twin
-	variables, so ASSIGN can last across RETURN/CALL as appropriate.
-
-Fri Sep 22 20:21:18 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Makefile.in: fini is a host program, so it needs a host-compiled
-	version of proj.o, named proj-h.o.  f/fini, f/fini.o, and
-	f/proj-h.o targets updated accordingly.
-
-	* com.c (__eprintf): New function.
-
-Wed Sep 20 02:26:36 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* lang-options.h: Add omitted -funix-intrinsics-* options.
-
-	* malloc.c (malloc_find_inpool_): Check for infinite
-	loop, crash if detected (user reports encountering
-	them in some large programs, this might help track
-	down the bugs).
-
-Thu Sep  7 13:00:32 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (lang_print_error_function): Don't dereference null
-	pointer when outside any program unit.
-	(ffecom_let_char_, ffecom_arg_ptr_to_expr): If catlist
-	item or length ever error_mark_node, don't continue processing,
-	since back-end functions like build_pointer_type crash on
-	error_mark_node's (due to pushing bad obstacks, etc.).
-
-Wed Aug 30 15:58:35 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.16 released.
-
-Mon Aug 28 12:24:20 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bad.c (ffebad_finish): Fix botched message when no places
-	are printed (due to unknown line info, etc.).
-
-	* std.c (ffestd_subr_labels_): Do a better job finding
-	line info in the case of typeANY and diagnostics.
-
-Fri Aug 25 15:19:29 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (DECL_ARTIFICIAL): Surround all references to this
-	macro with #if !BUILT_FOR_270 and #endif.
-	(init_lex): Surround print_error_function decl with
-	#if !BUILT_FOR_270 and #endif.
-	(lang_init): Call new ffelex_hash_kludge function to solve
-	problem with preprocessed files that have INCLUDE statements.
-
-	* lex.c (ffelex_getc_): New function.
-	(ffelex_cfelex_): Use ffelex_getc_ instead of getc in any
-	paths of code that can be affected by ffelex_hash_kludge.
-	Don't make an EOF token for unrecognized token; set token
-	to NULL instead, to avoid problems when not initialized.
-	(ffelex_hash_): Use ffelex_getc_ instead of getc in any
-	paths of code that can be affected by ffelex_hash_kludge.
-	Test token returned by ffelex_cfelex_ for NULL, meaning
-	unrecognized token.
-	Get rid of useless used_up variable.
-	Don't do ffewhere stuff or kill any tokens if in
-	ffelex_hash_kludge.
-	(ffelex_file_fixed, ffelex_file_free): Use ffelex_getc_
-	instead of getc in any paths of code that can be affected
-	by ffelex_hash_kludge.
-	(ffelex_hash_kludge): New function.
-
-	* lex.h (ffelex_hash_kludge): New function.
-
-Wed Aug 23 15:17:40 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c: Implement -f(no-)underscoring options by always
-	compiling in code to do it, and having that code inhibit
-	itself when -fno-underscoring is in effect.  This option
-	overrides -f(no-)f2c for this purpose; -f(no-)f2c returns
-	to it's <=0.5.15 behavior of affecting only how code
-	is generated, not how/whether names are mangled.
-
-	* target.h: Redo specification of appending underscores so
-	the macros are named "_default" instead of "_is" and the
-	two-underscore macro defaults to 1.
-
-	* top.c, top.h (underscoring): Add appropriate stuff
-	for the -f(no-)underscoring options.
-
-Tue Aug 22 10:25:01 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bad.c (ffebad_finish): Call report_error_function (in toplev.c)
-	to better identify location of problem.
-	Say "(continued):" instead of "(continued:)" for consistency.
-
-	* com.c (ffecom_gen_sfuncdef_): Set and reset new
-	ffecom_nested_entry_ variable to hold ffesymbol being compiled.
-	(lang_print_error_function): New function from toplev.c.
-	Use ffecom_nested_entry_ to help determine which name
-	and kind-string to print.
-	(ffecom_expr_intrinsic_): Handle EXIT and FLUSH invocations
-	with different calling sequences than library functions.
-	Have SIGNAL and SYSTEM push and pop calltemps, and convert
-	their return values to the destination type (just in case).
-	(FFECOM_rttypeINT_): New return type for `int', in case
-	gcc/f/runtime/libF77/system_.c(system_) is really supposed
-	to return `int' instead of `ftnint'.
-
-	* com.h (report_error_function): Declare this.
-
-	* equiv.c (ffeequiv_layout_local_): Don't forget to consider
-	root variable itself as possible "first rooted variable",
-	else might never set symbol and then crash later.
-
-	* intrin.c (ffeintrin_check_exit_): Change to allow no args
-	and rename to ffeintrin_check_int_1_o_ for `optional'.
-	#define ffeintrin_check_exit_ and _flush_ to this new
-	function, so intrin.def can refer to the appropriate names.
-
-	* intrin.def (FFEINTRIN_impFLUSH): Validate using
-	ffeintrin_check_flush_ so passing an INTEGER arg is allowed.
-
-	* lex.c (ffelex_file_push_, ffelex_file_pop_): New functions
-	to manage input_file_stack in gbe.
-	(ffelex_hash_): Call new functions (instead of doing code).
-	(ffelex_include_): Call new functions to update stack for
-	INCLUDE (_hash_ handles cpp output of #include).
-
-Mon Aug 21 08:09:04 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Makefile.in: Put `-W' in front of every `-Wall', since
-	2.7.0 requires that to engage `-Wunused' for parameters.
-
-	* com.c: Mark all parameters as artificial, so
-	`-W -Wunused' doesn't complain about unused ones (since
-	there's no way right not to individually specify attributes
-	like `unused').
-
-	* proj.h: Don't #define UNUSED if already defined, regardless
-	of host compiler.
-
-Sun Aug 20 16:03:56 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* gbe/2.7.0.diff: Regenerate.
-
-	* lang-options.h, lang-specs.h: If not __STDC__ (ANSI C),
-	avoid doing anything, especially the stringizing in -specs.h.
-
-Thu Aug 17 03:36:12 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* lang-specs.h: Remove useless optional settings of -traditional,
-	since -traditional is always set anyway.
-
-Wed Aug 16 16:56:46 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Make-lang.in (F2C_INSTALL_FLAG, F2CLIBOK): More
-	control over whether to install f2c-related stuff.
-	(install-f2c-*): New targets to install f2c-related
-	stuff in system, not just gcc, directories.
-
-	* com.c: Change calls to ffecom_get_invented_identifier
-	to use generally more predictable names.
-	Change calls to build_range_type to ensure consistency
-	of types of operands.
-	(ffecom_get_external_identifier_): Change to accept
-	symbol info, not just text, so it can use f2c flag for
-	symbol to decide whether to append underscore(s).
-	(ffecom_get_identifier_): Don't change names if f2c flag
-	off for compilation.
-	(ffecom_type_permanent_copy_): Use same type for new max as
-	used for min.
-	(ffecom_notify_init_storage): Offline fixups for stand-alone.
-
-	* data.c (ffedata_gather): Explicitly test for common block,
-	since it's no longer always the case that a local EQUIVALENCE
-	group has no symbol ptr (it now can, if a user-predictable
-	"rooted" symbol has been identified).
-
-	* equiv.c: Add some debugging stuff.
-	(ffeequiv_layout_local_): Set symbol ptr with user-predictable
-	"rooted" symbol, for giving the invented aggregate a
-	predictable name.
-
-	* g77.c (append_arg): Allow for 20 extra args instead of 10.
-	(main): For version-only case, add `-fnull-version' and, unless
-	explicitly omitted, `-lf2c -lm'.
-
-	* lang-options.h: New "-fnull-version" option.
-
-	* lang-specs.h: Support ".fpp" suffix for preprocessed source
-	(useful for OS/2, MS-DOS, other case-insensitive systems).
-
-	* stc.c (ffestc_R544_equiv_): Swap way lists are merged so this
-	is consistent with the order in which lists are built, making
-	user predictability of invented aggregate name much higher.
-
-	* storag.c, storag.h (FFESTORAG_typeDUMMY): Delete this enum.
-
-	* top.c: Accept, but otherwise ignore, `-fnull-version'.
-
-Tue Aug 15 07:01:07 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* DOC, INSTALL, PROJECTS: Extensive improvements to documentation.
-
-Sun Aug 13 01:55:18 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* INSTALL (f77-install-ok): Document the use of this file.
-
-	* Make-lang.in (F77_INSTALL_FLAG): New flag to control
-	whether to install an `f77' command (based on whether
-	a file named `f77-install-ok' exists in the source or
-	build directory) to replace the broken attempt to use
-	comment lines to avoid installing `f77' (broken in the
-	sense that it prevented installation of `g77').
-
-Mon Aug  7 06:14:26 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* DOC: Add new sections for g77 & gcc compiler options,
-	source code form, and types, sizes and precisions.
-	Remove lots of old "delta-version" info, or at least
-	summarize it.
-
-	* INSTALL: Add info here that used to be in DOC.
-	Other changes.
-
-	* g77.c (lookup_option, main): Check for --print-* options,
-	so we avoid adding version-determining stuff.
-
-Wed Jul 26 15:51:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Make-lang.in, Makefile.in (input.j, INPUT_H): New file.
-	Update dependencies accordingly.
-
-	* bad.c (ffebad_here): Okay to use unknown line/col.
-
-	* compilers.h (@f77-cpp-input): Remove -P option now that
-	# directives are handled by f771.  Update other options
-	to be more consistent with @c in gcc/gcc.c.  Don't run f771
-	if -E specified, etc., a la @c.
-	(@f77): Don't run f771 if -E specified, etc., a la @c.
-
-	* config-lang.in: Avoid use of word "guaranteed".
-
-	* input.j: New file to wrap around gcc/input.h.
-
-	* lex.j: Add support for parsing # directives output by cpp.
-	(ffelex_cfebackslash_): New function.
-	(ffelex_cfelex_): New function.
-	(ffelex_get_directive_line_): New function.
-	(ffelex_hash_): New function.
-	(ffelex_include_): Change to not use ffewhere_file_(begin|end).
-	Also fix bug in pointing to next line (for diagnostics, &c)
-	following successful INCLUDE.
-	(ffelex_next_line_): New function that does chunk of code
-	seen in several places elsewhere in the lexers.
-	(ffelex_file_fixed): Delay finishing statement until source
-	line is registered with ffewhere, so INCLUDE processing
-	picks up the info correctly.
-	Okay to kill or use unknown line/col objects now.
-	Handle HASH (#) lines.
-	Reorder tests for insubstantial lines to put most frequent
-	occurrences at top, for possible minor speedup.
-	Some general consolidation of code.
-	(ffelex_file_free): Handle HASH (#) lines.
-	Okay to kill or use unknown line/col objects now.
-	Some general consolidation of code.
-	(ffelex_init_1): Detect HASH (#) lines.
-	(ffelex_set_expecting_hollerith): Okay to kill or use unknown
-	line/col objects now.
-
-	* lex.h (FFELEX_typeHASH): New enum.
-
-	* options-lang.h (-fident, -fno-ident): New options.
-
-	* stw.c (ffestw_update): Okay to kill unknown line/col objects
-	now.
-
-	* target.h (FFETARGET_okREALQUAD, FFETARGET_okCOMPLEXDOUBLE,
-	FFETARGET_okCOMPLEXQUAD): #define these appropriately.
-
-	* top.c: Include flag.j wrapper, not flags.h directly.
-	(ffe_is_ident_): New flag.
-	(ffe_decode_option): Handle -fident and -fno-ident.
-	(ffe_file): Replace obsolete ffewhere_file_(begin|end) with
-	ffewhere_file_set.
-
-	* top.h (ffe_is_ident_, ffe_is_ident, ffe_set_is_ident):
-	New flag and access functions.
-
-	* where.c, where.h: Remove all tracking of parent file.
-	(ffewhere_file_begin, ffewhere_file_end): Delete these.
-	(ffewhere_line_use): Make it work with unknown line object.
-
-Mon Jul 17 03:04:09 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_sym_transform_): Set DECL_IN_SYSTEM_HEADER
-	flag for any local vars used as stmtfunc dummies or DATA
-	implied-DO iter vars, so no -Wunused warnings are produced
-	for them (a la f2c).
-	(ffecom_init_0): Do "extern int xargc;" for IARGC() intrinsic.
-	Warn if target machine not 32 bits, since g77 isn't yet
-	working on them at all well.
-
-	* expr.c (ffeexpr_sym_lhs_call_, ffeexpr_sym_lhs_data_,
-	ffeexpr_sym_lhs_extfunc_, ffeexpr_sym_rhs_actualarg_,
-	ffeexpr_sym_rhs_let_, ffeexpr_paren_rhs_let_): Don't
-	gratuitously set attr bits that don't apply just
-	to avoid null set meaning error; instead, use explicit
-	error flag, and allow null attr set, to
-	fix certain bugs discovered by looking at this code.
-
-	* g77.c: Major changes to improve support for gcc long options,
-	to make `g77 -v' report more useful info, and so on.
-
-Mon Jul  3 14:49:16 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* DOC, com.c, intrin.h, intrin.c, intrin.def, target.h, top.c,
-	top.h: Add new `unix' group of intrinsics, which includes the
-	newly added ERF, ERFC, EXIT, plus even newer ABORT, DERF, DERFC,
-	FLUSH, GETARG, GETENV, SIGNAL, and SYSTEM.
-
-Tue Jun 27 23:01:05 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bld.c, bld.h (ffebld_constant_pool,
-	ffebld_constant_character_pool): Use a single macro (the
-	former) to access the pool for allocating constants, instead
-	of latter in public and FFEBLD_CONSTANT_POOL_ internally
-	in bld.c (which was the only one that was correct before
-	these changes).  Add verification of integrity of certain
-	heap-allocated areas.
-
-	* com.c (ffecom_overlap_, ffecom_args_overlap_,
-	ffecom_tree_canonize_ptr_, ffecom_tree_canonize_ref_): New
-	functions to optimize calling COMPLEX and, someday, CHARACTER
-	functions requiring additional argument to be passed.
-	(ffecom_call_, ffecom_call_binop_, ffecom_expr_,
-	ffecom_expr_intrinsic_): Change calling
-	sequences to include more info on possible destination.
-	(ffecom_expr_intrinsic_): Add ERF(), ERFC(), and EXIT()
-	intrinsic code.
-	(ffecom_sym_transform_): For assumed-size arrays, set high
-	bound to highest possible value instead of low bound, to
-	improve validity of overlap checking.
-	(duplicate_decls): If olddecl and newdecl are the same,
-	don't do any munging, just return affirmative.
-
-	* expr.c: Change ffecom_constant_character_pool() to
-	ffecom_constant_pool().
-
-	* info.c (ffeinfo_new): Compile this version if not being
-	compiled by GNU C.
-
-	* info.h (ffeinfo_new): Don't define macro if not being
-	compiled by GNU C.
-
-	* intrin.c, intrin.def: Add ERF(), ERFC(), and EXIT() intrinsics.
-	(ffeintrin_check_exit_): New for EXIT() subroutine intrinsic.
-
-	* malloc.c, malloc.h (malloc_verify_*): New functions to verify
-	integrity of heap-storage areas.
-
-	* stc.c (ffestc_R834, ffestc_R835): Handle possibility that
-	an enclosing DO won't have a construct name even when the
-	CYCLE/EXIT does (i.e. without dereferencing NULL).
-
-	* target.c, target.h (ffetarget_verify_character1): New function
-	to verify integrity of heap storage used to hold character constant.
-
-Thu Jun 22 15:36:39 1995  Howard Gordon  (flash@super.org)
-
-	* stp.h (ffestpVxtcodeIx): Fix typo in typedef for this.
-
-Mon May 29 15:22:31 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* *: Make all sorts of changes to accommodate upcoming gcc-2.7.0.
-	I didn't keep track of them, nor just when I made them, nor
-	when I (much later, probably in early August 1995) modified
-	them so they could properly handle both 2.7.0 and 2.6.x.
-
-	* com.c (ffecom_expr_power_integer_): Don't expand_start_stmt_expr
-	if transforming dummy args, because the back end cannot handle
-	that (it's rejected by the gcc front end), just generate
-	call to run-time library.
-	Back out changes in 0.5.15 because more temporaries might be
-	needed anyway (for COMPLEX**INTEGER).
-	(ffecom_push_tempvar): Remove inhibitor.
-	Around start_decl and finish_decl (in particular, arround
-	expand_decl, which is called by them), push NULL_TREE into
-	sequence_rtl_expr, an external published by gcc/function.c.
-	This makes sure the temporary is truly in the function's
-	context, not the inner context of a statement-valued expression.
-	(I think the back end is inconsistent here, but am not
-	interested in convincing the gbe maintainers about this now.)
-	(pushdecl): Make sure that when pushing PARM_DECLs, nothing
-	other than them are pushed, as happened for 0.5.15 and which,
-	if done for other reasons not fixed here, might well indicate
-	some other problem -- so crash if it happens.
-
-	* equiv.c (ffeequiv_layout_local_): If the local equiv group
-	has a non-nil COMMON field, it should mean that an error has
-	occurred and been reported, so just trash the local equiv
-	group and do nothing.
-
-	* stc.c (ffestc_promote_sfdummy_): Set sfdummy arg state to
-	UNDERSTOOD so above checking for duplicate args actually
-	works, and so we don't crash later in pushdecl.
-
-	* ste.c (ffeste_R1001): Set initial value only for VAR_DECLs,
-	not for, e.g., LABEL_DECLs, which the FORMAT label can be
-	if it was previously treated as an executable label.
-
-Sat May 20 01:53:53 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_sym_transform_): For adjustable arrays,
-	pass high bound through variable_size in case its primaries
-	are changed (dumb0.f, and this might also improve
-	performance so it approaches f2c|gcc).
-
-Fri May 19 11:00:36 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.15 released.
-
-	* com.c (ffecom_expr_power_integer_): Push temp vars
-	before expanding a statement expression, since that seems
-	to cause temp vars to be "forgotten" after the end of the
-	expansion in the back end.  Disallow more temp-var
-	pushing during such an expansion, just in case.
-	(ffecom_push_tempvar): Crash if a new variable needs to be
-	pushed but cannot be at this point (should never happen).
-
-Wed May 17 12:26:16 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* expr.c (ffeexpr_collapse_convert): Add code to convert
-	LOGICAL to CHARACTER.  Reject conversion of REAL or COMPLEX
-	to CHARACTER entirely, as it cannot be supported with all
-	configurations.
-
-	* target.h, target.c (ffetarget_convert_character1_logical1):
-	New function.
-
-Sun May 14 00:00:09 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_do_entry_, ffecom_gen_sfuncdef_,
-	ffecom_start_progunit_, ffecom_sym_transform_,
-	ffecom_init_0, start_function): Changes to have REAL
-	external functions return same type as DOUBLE PRECISION
-	external functions when -ff2c is in force; while at it,
-	some code cleanups done.
-
-	* stc.c (ffestc_R547_item_object): Disallow array declarator
-	if one already exists for symbol.
-
-	* ste.c (ffeste_R1227): Convert result variable to type
-	of function result as seen by back end (e.g. for when REAL
-	external function actually returns result as double).
-
-	* target.h (FFETARGET_defaultFIXED_LINE_LENGTH): New
-	macro for default for -ffixed-line-length-N option.
-
-	* top.c (ffe_fixed_line_length_): Initialize this to new
-	target.h macro instead of constant 72.
-
-Tue May  9 01:20:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* lex.c (ffelex_send_token_): If sending CHARACTER token with
-	null text field, put a single '\0' in it and set length/size
-	fields to 0 (to fix 950508-0.f).
-	(ffelex_image_char_): When setting ffelex_bad_line_ to TRUE,
-	always "close" card image by appending a null char and setting
-	ffelex_card_length_.  As part of this, append useful text
-	to identify the two kinds of problems that involve this.
-	(ffelex_file_fixed): Reset ffelex_bad_line_ to FALSE after
-	seeing a line with invalid first character (fixes 950508-1.f).
-	If final nontab column is zero, assume tab seen in line.
-	(ffelex_card_image_): Always make this array 8 characters
-	longer than reflected by ffelex_card_size_.
-	(ffelex_init_1): Get final nontab column info from top instead
-	of assuming 72.
-
-	* options-lang.h: Add -ffixed-line-length- prefix.
-
-	* top.h: Add ffe_fixed_line_length() and _set_ version, plus
-	corresponding extern.
-
-	* top.c: Handle -ffixed-line-length- option prefix.
-
-Fri Apr 28 05:40:25 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.14 released.
-
-	* Make-lang.in: Add assert.j.
-
-	* Makefile.in: Add assert.j.
-
-	* assert.j: New file.
-
-Thu Apr 27 16:24:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bad.h (ffebad_severity): New function.
-
-	* bad.c (ffebad_severity): New function.
-
-	* bad.def (FFEBAD_OPEN_INCLUDE): Change severity from SEVERE
-	to FATAL, since processing continues, and that seems fine.
-
-	* com.c: Add facility to handle -I.
-	(ffecom_file, ffecom_close_include, ffecom_open_include,
-	ffecom_decode_include_option): New global functions for -I.
-	(ffecom_file_, ffecom_initialize_char_syntax_,
-	ffecom_close_include_, ffecom_decode_include_option_,
-	ffecom_open_include_, append_include_chain, open_include_file,
-	print_containing_files, read_filename_string, file_name_map,
-	savestring): New internal functions for -I.
-
-	* compilers.h: Pass -I flag(s) to f771 (via "%{I*}").
-
-	* lex.c (ffelex_include_): Call ffecom_close_include
-	to close include file, for its tracking needs for -I,
-	instead of using fclose.
-
-	* options-lang.h: Add -I prefix.
-
-	* parse.c (yyparse): Call ffecom_file for main input file,
-	so -I handling works (diagnostics).
-
-	* std.c (ffestd_S3P4): Have ffecom_open_include handle
-	opening and diagnosing errors with INCLUDE files.
-
-	* ste.c (ffeste_begin_iterdo_): Use correct algorithm for
-	calculating # of iterations -- mathematically similar but
-	computationally different algorithm was not handling cases
-	like "DO I=6,5,2" correctly, because (5-6)/2+1 => 1, not 0.
-
-	* top.c (ffe_decode_option): Allow -I, restructure a bit
-	for clarity and, maybe, speed.
-
-Mon Apr 17 13:31:11 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* g77.c: Remove -lc, turns out not all systems has it, but
-	leave other changes in for clarity of code.
-
-Sun Apr 16 21:50:33 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_expr_): Implement ARRAY_EXPR as INDIRECT_REF
-	of appropriate PLUS_EXPRs of ptr_to_expr of array, to see
-	if this generates better code.  (Conditional on
-	FFECOM_FASTER_ARRAY_REFS.)
-
-Sun Apr 16 00:22:48 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Make-lang.in (F77_SRCS): Remove g77.c, since it doesn't
-	contribute to building f771.
-
-	* Makefile.in (dircheck): Remove/replace with f/Makefile, because
-	phony targets that are referenced in other real targets get run
-	when those targets are specified, which is a waste of time (e.g.
-	when rebuilding and only g77.c has changed, f771 was being linked
-	anyway).
-
-	* g77.c: Include -lc between -lf2c and -lm throughout.
-
-	* implic.c (ffeimplic_establish_symbol): If -Wimplicit, warn if
-	implicit type given to symbol.
-
-	* lex.c (ffelex_include_): Don't gratuitously increment line
-	number here.
-
-	* top.h, top.c (ffe_is_warn_implicit_): New global variable and
-	related access macros.
-	(ffe_decode_option): Handle -W options, including -Wall and
-	-Wimplicit.
-
-	* where.c (ffewhere_line_new): Don't muck with root line (was
-	crashing on null input since lexer changes over the past week
-	or so).
-
-Thu Apr 13 16:48:30 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_init_0): Register built-in functions for cos,
-	sin, and sqrt.
-	(ffecom_tree_fun_type_double): New variable.
-	(ffecom_expr_intrinsic_): Update f2c input and output files
-	to latest version of f2c (no important g77-related changes
-	noted, just bug fixes to f2c and such).
-	(builtin_function): New function from c-decl.c.
-
-	* com-rt.def: Refer to built-in functions for cos, sin, and sqrt.
-
-Thu Apr 13 10:25:09 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_expr_intrinsic_): Convert 0. to appropriate
-	type to keep DCMPLX(I) from crashing the compiler.
-	(ffecom_expr_): Don't convert result from ffecom_tree_divide_.
-	(ffecom_tree_divide_): Add tree_type argument, have all callers
-	pass one, and don't convert right-hand operand to it (this is
-	to make this new function work as much like the old in-line
-	code used in ffecom_expr_ as possible).
-
-	* lex.c: Maintain lineno and input_filename the way the gcc
-	lexer does.
-
-	* std.c (ffestd_exec_end): Save and restore lineno and
-	input_filename around the second pass, which sets them
-	appropriately for each saved statement.
-
-Wed Apr 12 09:44:45 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_expr_power_integer_): New function.
-	(ffecom_expr_): Call new function for power op with integer second
-	argument, for generating better code.  Also replace divide
-	code with call to new ffecom_tree_divide_ function.
-	Canonicalize calls to ffecom_truth_value(_invert).
-	(ffecom_tree_divide_): New function.
-
-Wed Apr  5 14:15:44 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* lex.c: Change to allocate text for tokens only when actually
-	needed, which should speed compilation up somewhat.
-	Change to allow INCLUDE at any point where a statement
-	can end, i.e. in ffelex_finish_statement_ or when a SEMICOLON
-	token is sent.
-	Remove some old, obsolete code.
-	Clean up layout of entire file to improve formatting,
-	readability, etc.
-	(ffelex_set_expecting_hollerith): Remove include argument.
-
-Fri Mar 31 23:19:08 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bad.h, bad.c (ffebad_start_msg, ffebad_start_msg_lex):
-	New functions to generate arbitrary messages.
-	(FFEBAD_severityPEDANTIC): New severity, to correspond
-	to toplev's pedwarn() function.
-
-	* lex.c (ffelex_backslash_): New function to implement
-	backslash processing.
-	(ffelex_file_fixed, ffelex_file_free): Implement new
-	backslash processing.
-
-	* std.c (ffestd_R1001dump_): Don't assume CHARACTER and
-	HOLLERITH tokens stop at '\0' characters, now that backslash
-	processing is supported -- use their advertised lengths instead,
-	and double up the '\002' character for libf2c.
-
-Mon Mar 27 17:10:33 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_init_local_zero_): Implement -finit-local-zero.
-	(ffecom_sym_transform_): Same.
-	(ffecom_transform_equiv_): Same.
-
-	* options-lang.h: Add -f(no-)(init-local-zero,backslash,ugly-init).
-
-	* stb.c (ffestb_V020): Reject "TYPEblah(...", which might be
-	an array assignment.
-
-	* target.h, top.h, top.c: Implement -finit-local-zero.
-
-Fri Mar 24 19:56:22 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Make-lang.in, Makefile.in: Remove conf-proj(.in) and
-	proj.h(.in) rules, plus related config.log, config.cache,
-	and config.status stuff.
-
-	* com.c (ffecom_init_0): Change messages when atof(), bsearch(),
-	or strtoul() do not work as expected in the start-up test.
-
-	* conf-proj, conf-proj.in: Delete.
-
-	* lex.c (ffelex_file_fixed): Allow f2c's '&' in column 1
-	to mean continuation line.
-
-	* options-lang.h: New file, #include'd by ../toplev.c.
-
-	* proj.h.in: Rename back to proj.h.
-
-	* proj.h (LAME_ASSERT): Remove.
-	(LAME_STDIO): Remove.
-	(NO_STDDEF): Remove.
-	(NO_STDLIB): Remove.
-	(NO_BSEARCH): Remove auto detection, rename to !FFEPROJ_BSEARCH.
-	(NO_STRTOUL): Remove auto detection, rename to !FFEPROJ_STRTOUL.
-	(USE_HOST_LIMITS): Remove (maybe still needed by stand-alone?).
-	(STR, STRX): Do only ANSI C definitions.
-
-Mon Mar 13 10:46:13 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* BUGS: Add item about g77 requiring gcc to compile it.
-
-	* NEWS: New file listing user-visible changes in the release.
-
-	* PROJECTS: Update to include a new item or two, and modify
-	or delete items that are addressed in this or previous releases.
-
-	* bad.c (ffebad_finish): Don't crash if missing string &c,
-	just substitute obviously distressed string "[REPORT BUG!!]"
-	for cases where the message/caller are fudgy.
-
-	* bad.def: Clean up error messages in a major way, add new ones
-	for use by changes in target.c.
-
-	* com.c (ffecom_expr_): Handle opANY in opCONVERT.
-	(ffecom_let_char_): Disregard destinations with ERROR_MARK.
-	(ffecom_1, ffecom_1_fn, ffecom_2, ffecom_2s, ffecom_3,
-	ffecom_3s, &c): Check all inputs for error_mark_node.
-	(ffecom_start_progunit_): Don't transform all symbols
-	in BLOCK DATA, since it never executes, and it is silly
-	to, e.g., generate all the structures for NAMELIST.
-	(ffecom_char_length_expr_): Rename to ffecom_intrinsic_len_.
-	(ffecom_intrinsic_ichar_): New function to handle ICHAR of
-	arbitrary expression with possible 0-length operands.
-	(ffecom_expr_intrinsic_): Use ffecom_intrinsic_char_.
-	For MVBITS, set tree_type to void_type_node.
-	(ffecom_start_progunit_): Name master function for entry points
-	after primary entry point so users can easily guess it while
-	debugging.
-	(ffecom_arg_ptr_to_expr): Change treatment of Hollerith,
-	Typeless, and %DESCR.
-	(ffecom_expr_): Change treatment of Hollerith.
-
-	* data.c (ffedata_gather_): Handle opANY in opCONVERT.
-
-	* expr.c (ffeexpr_token_apostrophe_): Issue FFEBAD_NULL_CHAR_CONST
-	warning as necessary.
-	(ffeexpr_token_name_rhs_): Set context for args to intrinsic
-	so that assignment-like concatenation is allowed for ICHAR(),
-	IACHAR(), and LEN() intrinsics.
-	(ffeexpr_reduced_*_): Say "an array" instead of "an entity" in
-	diagnostics, since it's more informative.
-	(ffeexpr_finished_): For many contexts, check for null expression
-	and array before trying to do a conversion, to avoid redundant
-	diagnostics.
-
-	* g77.1: Fix typo for preprocessed suffix (.F, not .f).
-
-	* global.c (ffeglobal_init_common): Warn if initializing
-	blank common.
-	(ffeglobal_pad_common): Enable code to warn if initial
-	padding needed.
-	(ffeglobal_size_common): Complain if enlarging already-
-	initialized common, since it won't work right anyway.
-
-	* intrin.c: Add IMAG() intrinsic.
-	(ffeintrin_check_loc_): Allow opSUBSTR in LOC().
-
-	* intrin.def: Add IMAG() intrinsic.
-
-	* lex.c: Don't report FFEBAD_NULL_CHAR_CONST errors.
-
-	* sta.c, sta.h, stb.c: Changes to clean up error messages (see
-	bad.def).
-
-	* stb.c (ffestb_R100113_): Issue FFEBAD_NULL_CHAR_CONST
-	warning as necessary.
-
-	* stc.c (ffestc_shriek_do_): Don't try to reference doref_line
-	stuff in ANY case, since it won't be valid.
-	(ffestc_R1227): Allow RETURN in main program unit, with
-	appropriate warnings/errors.
-	(ffestc_subr_format_): Array of any type is a CHAREXPR (F77 C5).
-
-	* ste.c (ffeste_begin_doiter_): Couple of fixes to accurately
-	determine if loop never executes.
-
-	* target.c (ffetarget_convert_*_hollerith_): Append spaces,
-	not zeros, to follow F77 Appendix C, and to warn when
-	truncation of non-blanks done.
-	(ffetarget_convert_*_typeless): Rewrite to do typeless
-	conversions properly, and warn when truncation done.
-	(ffetarget_print_binary, ffetarget_print_octal,
-	ffetarget_print_hex): Rewrite to use new implementation of
-	typeless.
-	(ffetarget_typeless_*): Rewrite to use new implementation
-	of typeless, and to warn about overflow.
-
-	* target.h (ffetargetTypeless): New implementation of
-	this type.
-
-	* type.h, type.c (ffetype_size_typeless): Remove (incorrect)
-	implementation of this function and its extern.
-
-Sun Mar  5 18:46:42 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* BUGS: Clarify that constant handling would also fix lack of
-	adequate IEEE-754/854 support to some degree, and typeless
-	and non-decimal constants.
-
-	* com.c (ffecom_type_permanent_copy_): Comment out to avoid
-	warnings.
-	(duplicate_decls): New function a la gcc/c-decl.c.
-	(pushdecl): Use duplicate_decls to decide whether to return
-	existing decl or new one, instead of always returning existing
-	decl.
-	(ffecom_expr_): opPERCENT_LOC now supports CHARACTER arguments.
-	(ffecom_init_0): Give f2c I/O code 0 for basictypeANY/kindtypeANY.
-	(ffecom_sym_transform_): For adjustable arrays, pass low bound
-	through variable_size in case its primaries are changed (950302-1.f).
-
-	* com.h: More decls that belong in tree.h &c.
-
-	* data.c (ffedata_eval_integer1_): Fix opPAREN case to not
-	treat value of expression as an error code.
-
-	* expr.c (ffeexpr_finished_): Allow opSUBSTR in contextLOC case.
-
-	* proj.c: Add "const" as appropriate.
-
-Mon Feb 27 10:04:03 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* bad.def (FFEBAD_BAD_SUBSTR): Fix bad grammar in message.
-
-Fri Feb 24 16:21:31 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.13 released.
-
-	* INSTALL: Warn that f/zzz.o will compare differently between
-	stages, since it puts the __TIME__ macro into a string.
-
-	* com.c (ffecom_sym_transform_): Transform kindFUNCTION/whereDUMMY
-	to pointer-to-function, not function.
-	(ffecom_expr_): Use ffecom_arg_ptr_to_expr instead of
-	ffecom_char_args_ to handle comparison between CHARACTER
-	types, so either operand can be a CONCATENATE.
-	(ffecom_transform_common_): Set size of initialized common area
-	to global (largest-known) size, even though size of init might
-	be smaller.
-
-	* equiv.c (ffeequiv_offset_): Check symbol info for ANY.
-
-	* expr.c (ffeexpr_find_close_paren_, ffeexpr_nil_*): New functions
-	to handle following the contour of a rejected expression, so
-	statements like "PRINT(I,I,I)=0" don't cause the PRINT statement
-	code to get the second passed back to it as if there was a
-	missing close-paren before it, the comma causing the PRINT code
-	to confirm the statement, resulting in an ambiguity vis-a-vis
-	the let statement code.
-	Use the new ffecom_find_close_paren_ handler when an expected
-	close-paren is missing.
-	(ffeexpr_isdigits_): New function, use in all places that
-	currently use isdigit in repetitive code.
-	(ffeexpr_collapse_symter): Collapse to ANY if init-expr is ANY,
-	so as to avoid having symbol get "transformed" if used to
-	dimension an array.
-	(ffeexpr_token_real_, ffeexpr_token_number_real_): Don't issue
-	diagnostic about exponent, since it'll be passed along the
-	handler path, resulting in a diagnostic anyway.
-	(ffeexpr_token_apos_char_): Use consistent handler path
-	regardless of whether diagnostics inhibited.
-	(ffeexpr_token_name_apos_name_): Skip past closing quote/apos
-	even if not a match or other diagnostic issued.
-	(ffeexpr_sym_impdoitem_): Exec-transition local SEEN symbol.
-
-	* lex.c (ffelex_image_char_): Set ffelex_saw_tab_ if TAB
-	seen, not if anything other than TAB seen!
-
-	* stc.c (ffestc_R537_item): If source is ANY but dest isn't,
-	set dest symbol's init expr to ANY.
-	(ffestc_R501_attrib, ffestc_R522, ffestc_R522start): Complain
-	about conflict between "SAVE" by itself and other uses of
-	SAVE only in pedantic mode.
-
-	* ste.c (ffeste_R1212): Fix loop over labels to always
-	increment caseno, to avoid pushcase returning 2 for duplicate
-	values when one of the labels is invalid.
-
-Thu Feb 23 12:42:04 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.12 released.
-
-	* Make-lang.in (f77.install-common): Add "else true;" before outer
-	"fi" per Makefile.in patch.
-
-	* Makefile.in (dircheck): Add "else true;" before "fi" per
-	patch from chs1pm@surrey.ac.uk.
-
-	* com.c (ffecom_push_tempvar): If type desired is ERROR_MARK,
-	return error_mark_node, to avoid crash that results from
-	making a VAR_DECL with error_mark_node as its type.
-
-	* ste.c (ffeste_begin_iterdo_): Convert itercount to INTEGER
-	anytime calculation of number of iterations ends up with type
-	other than INTEGER (e.g. DOUBLE PRECISION, REAL).
-
-Thu Feb 23 02:48:38 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.11 released.
-
-	* DOC: Explain -fugly-args.
-
-	* bad.def (FFEBAD_ACTUALARG): Explain -fugly-args and how to
-	rewrite code to not require it.
-
-	* com.c (ffecom_vardesc_): Handle negative type code, just in
-	case.
-	(ffecom_arg_ptr_to_expr): Let ffecom_expr handle hollerith
-	and typeless constants (move code to ffecom_constantunion).
-	(ffecom_constantunion): Handle hollerith and typeless constants.
-
-	* expr.c (ffecom_finished_): Check -fugly-args in actual-arg
-	context where hollerith/typeless provided.
-
-	* intrin.def (FFEINTRIN_genDFLOAT): Add FFEINTRIN_specDFLOAT.
-	(FFEINTRIN_specDFLOAT): Add as f2c intrinsic.
-
-	* target.h (ffetarget_convert_real[12]_integer,
-	ffetarget_convert_complex[12]_integer): Pass -1 for high integer
-	value if low part is negative.
-	(FFETARGET_defaultIS_UGLY_ARGS): New macro.
-
-	* top.c (ffe_is_ugly_args_): New variable.
-	(ffe_decode_option): Handle -fugly-args and -fno-ugly-args.
-
-	* top.h (ffe_is_ugly_args_, ffe_is_ugly_args(),
-	ffe_set_is_ugly_args()): New variable and macros.
-
-Thu Feb 23 02:48:38 1995  Pedro A M Vazquez  (vazquez@iqm.unicamp.br)
-
-	* g77.c (sys_errlist): Use const for __FreeBSD__ systems
-	as well.
-
-Wed Feb 22 13:33:43 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.10 released.
-
-	* CREDITS: Add Rick Niles.
-
-	* INSTALL: Note how to get around lack of makeinfo.
-
-	* Make-lang.in (f/proj.h): Remove # comment.
-
-	* Makefile.in (f/proj.h): Remove # comment.
-
-	* com.c (ffecom_expr_): Simplify opFUNCREF/opSUBRREF conversion.
-	(ffecom_sym_transform_): For whereGLOBAL and whereDUMMY
-	kindFUNCTION, use ffecom_tree_fun_type[][] only for non-constant
-	(non-statement-function) f2c functions.
-	(ffecom_init_0): ffecom_tree_fun_type[][] and _ptr_to_*_* are
-	really f2c-interface arrays, so use base type void for COMPLEX
-	(like CHARACTER).
-
-Tue Feb 21 19:01:18 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (f77.install-common): Expurgate the test for and
-	possible installation of f2c in line with elsewhere.  Seems to have
-	been missing a semicolon anyhow!
-
-Tue Feb 21 11:45:25 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.9 released.
-
-	* Make-lang.in (f/proj.h): touch file to register update,
-	because the previous commands won't necessarily modify it.
-
-	* Makefile.in (f/proj.h): touch file to register update,
-	because the previous commands won't necessarily modify it.
-
-	* Makefile.in (f/str-*.h, f/str-*.j): Explicitly specify
-	output file names, so these targets go in build, not source,
-	directory.
-
-	* bits.c, bits.h: Switch to valid ANSI C replacement for
-	ARRAY_ZERO.
-
-	* com.c (ffecom_expr_): Add assignp arg to support ASSIGN better.
-	If assignp is TRUE, use different tree for FFEBLD_opSYMTER case.
-	(ffecom_sym_transform_assign_): New function.
-	(ffecom_expr_assign): New function.
-	(ffecom_expr_assign_w): New function.
-
-	* com.c (ffecom_f2c_make_type_): Do make_signed_type instead
-	of make_unsigned_type throughout.
-
-	* com.c (ffecom_finish_symbol_transform_): Expand scope of
-	commented-out code to probably produce faster compiler code.
-
-	* com.c (ffecom_gen_sfuncdef_): Push/pop calltemps so
-	COMPLEX works right.
-	Remove obsolete comment.
-
-	* com.c (ffecom_start_progunit_): If non-multi alt-entry
-	COMPLEX function, primary (static) entry point returns result
-	directory, not via extra arg -- to agree with ffecom_return_expr
-	and others.
-	Pretransform all symbols so statement functions are defined
-	before any code emitted.
-
-	* com.c (ffecom_finish_progunit): Don't posttransform all
-	symbols here -- pretransform them instead.
-
-	* com.c (ffecom_init_0): Don't warn about possible ASSIGN
-	crash, as this shouldn't happen now.
-
-	* com.c (ffecom_push_tempvar): Fix to handle temp vars
-	pushed while context is a statement (nested) function, and
-	add appropriate commentary.
-
-	* com.c (ffecom_return_expr): Check TREE_USED to determine
-	where return value is unset.
-
-	* com.h (struct _ffecom_symbol_): Add note about length_tree
-	now being used to keep tree for ASSIGN version of symbol.
-
-	* com.h (ffecom_expr_assign, ffecom_expr_assign_rw): New decls.
-	(error): Add this prototype for back-end function.
-
-	* fini.c (main): Grab input, output, and include names
-	directly off the command line instead of making the latter
-	two out of the first.
-
-	* lex.c: Improve tab handling for both fixed and free source
-	forms, and ignore carriage-returns on input, while generally
-	improving the code.  ffelex_handle_tab_ has been renamed and
-	reinvented as ffelex_image_char_, among other things.
-
-	* malloc.c, malloc.h: Switch to valid ANSI C replacement for
-	ARRAY_ZERO, and kill the full number of bytes in pools and
-	areas.
-
-	* proj.h.in (ARRAY_ZERO, ARRAY_ZERO_SIZE): Remove.
-
-	* ste.c (ffeste_io_cilist_, ffeste_io_icilist_, ffeste_R838,
-	ffeste_R839): Issue diagnostic if a too-narrow variable used in an
-	ASSIGN context despite changes to this code and code in com.c.
-
-	* where.c, where.h: Switch to valid ANSI C replacement for
-	ARRAY_ZERO.
-
-Fri Feb 17 03:35:19 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.8 released.
-
-	* INSTALL: In quick-build case, list g77 target first so g77
-	gets installed.  Also, explain that gcc gets built and installed
-	as well, even though this isn't really what we want (and maybe
-	we'll find a way around this someday).
-
-Fri Feb 17 02:35:41 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.7 released.
-
-	* Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Remove
-	../ prefix in front of .h files, since they're in the cd.
-
-Fri Feb 17 01:50:48 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.6 released.
-
-Thu Feb 16 20:26:54 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* ../README.g77: Remove description of g77 as "not-yet-published".
-
-	* CREDITS: More changes.
-
-	* Make-lang.in (G77STAGESTUFF): Remove cktyps stuff.
-
-	* Makefile.in (CONFIG_H, HCONFIG_H, TCONFIG_H, TM_H): Don't
-	prefix gcc dir with $(srcdir) since these don't live there,
-	they are created in the build dir by gcc's configure.  Add
-	a note explaining what these macros are about.
-	Update dependencies via deps-kinda.
-
-	* README.NEXTSTEP: Credit Toon, and per his request, add his
-	email address.
-
-	* com.h (FFECOM_DETERMINE_TYPES): #include "config.j".
-
-	* config.j, convert.j, flags.j, hconfig.j, rtl.j, tconfig.j,
-	tm.j, tree.j: Don't #include if already done.
-
-	* convert.j: #include "tree.j" first, as convert.h clearly depends
-	on trees being defined.
-
-	* rtl.j: #include "config.j" first, since there's some stuff
-	in rtl.h that assumes it has been #included.
-
-	* tree.j: #include "config.j" first, or real.h makes inconsistent
-	decision about return type of ereal_atof, leading to bugs, and
-	because tree.h/real.h assume config.h already included.
-
-Wed Feb 15 14:40:20 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.5 released.
-
-	* Copyright notices updated to be FSF-style.
-
-	* INSTALL: Some more clarification regarding building just f77.
-
-	* Make-lang.in (F77_SRCS): Update wrt changing some .h to .j.
-	(install-libf77): Fix typo in new parenthetical note.
-
-	* Makefile.in (f/*.o): Update.
-	(CONFIG_H, CONVERT_H, FLAGS_H, GLIMITS_H, HCONFIG_H, RTL_H,
-	TCONFIG_H, TM_H, TREE_H): Update/new symbols.
-	(deps-kinda): More fixes wrt changing some .h to .j.
-	Document and explain this rule a bit better.
-	Accommodate changes in output of gcc -MM.
-
-	* *.h, *.c: Change #include's so proj.h not assumed to #include
-	malloc.h or config.h (now config.j), and so new .j files are
-	used instead of old .h ones.
-
-	* com.c (ffecom_init_0): Use FLOAT_TYPE_SIZE for f2c's
-	TYLONG/TYLOGICAL type codes, to get g77 working on Alpha.
-
-	* com.h: Make all f2c-related integral types "int", not "long
-	int".
-
-	* config.j, convert.j, flags.j, glimits.j, hconfig.j, rtl.j,
-	tconfig.j, tm.j, tree.j: New files wrapping around gbe
-	.h files.
-
-	* config.h, convert.h, flags.h, glimits.h, hconfig.h, rtl.h,
-	tconfig.h, tm.h, tree.h: Deleted so new .j files
-	can #include the gbe files directly, instead of using "../",
-	and thus do better with various kinds of builds.
-
-	* proj.h: Delete unused NO_STDDEF and related stuff.
-
-Tue Feb 14 08:28:08 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* BUGS: Remove item #12, cross-compiling & autoconf scripts
-	reportedly expected to work properly (according to d.love).
-
-	* INSTALL: Add explanation of d.love's patch to config-lang.in.
-	Add explanation of how to install just g77 when gcc already installed.
-	Add note about usability of "-Wall".  Add note about bug-
-	reporting.
-
-	* Make-lang.in ($(srcdir)/f/conf-proj): Add comment about why
-	conf-proj.out.
-	(install-libf77): Echo parenthetical note to user about how to do
-	just the (aborted) libf2c installation.
-	(deps-kinda): Update to work with new configuration/build stuff.
-
-	* bad.c (ffebad_finish): Put capitalized "warning:" &c message
-	as prefix on any diagnostic without pointers into source.
-
-	* bad.def (FFEBAD_TOO_BIG_INIT): Add this warning message.
-
-	* config-lang.in: Add Dave Love's patch to catch case where
-	back-end patches not applied and abort configuration.
-
-	* data.c (ffedata_gather_, ffedata_value_): Warn when about
-	to initialize a large aggregate area, due to design flaw resulting
-	in too much time/space used to handle such cases.
-	Use COMMON area name, and first notice of symbol, for multiple-
-	initialization diagnostic, instead of member symbol and unknown
-	location.
-	(FFEDATA_sizeTOO_BIG_INIT_): New macro per above.
-
-Mon Feb 13 13:54:26 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (F77_SRCS): Use $(srcdir)/f/proj.h.in, not
-	$(srcdir)/f/proj.h for build outside srcdir.
-
-Sun Feb 12 13:37:11 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* ../README.g77: Clarify procedures for unpacking, add asterisks
-	to mark important things the user must do.
-
-	* Fix dates in/add dates to ../README.g77, BUGS, CREDITS, DOC,
-	INSTALL, PROJECTS, README.
-
-Sun Feb 12 00:26:10 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.4 released.
-
-	* Make-lang.in (f/proj.h): Reproduce this rule here from
-	Makefile.in.
-	($(srcdir)/f/conf-proj): Put autoconf's stdout in temp file
-	conf-proj.out, then mv to conf-proj only if successful, so
-	conf-proj not touched if autoconf not installed.
-
-	* Makefile.in ($(srcdir)/conf-proj): See Make-lang.in's similar
-	rule.
-
-Sat Feb 11 20:56:02 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* BUGS: Clarify some bugs.
-
-	* DOC: Many improvements and fixes.
-
-	* README: Move bulk of text, edited, to ../README.g77, and
-	replace with pointer to that file.
-
-	* com.c (ffecom_init_0): Comment out warning about sizeof(ftnlen)
-	as per ste.c change.  Add text about ASSIGN to help user understand
-	what is being warned about.
-
-	* conf-proj.in: Fix typos in comments.
-
-	* proj.h.in: Add ARRAY_ZERO_SIZE to parallel malloc.h's version,
-	in case it proves to be needed.
-
-	* ste.c: Comment out assertions requiring sizeof(ftnlen) >=
-	sizeof(char *), in the hopes that overflow will never happen.
-	(ffeste_R838): Change assertion to fatal() with at least
-	partially helpful message.
-
-Sat Feb 11 12:38:00 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* com.c (ffecom_vardesc_): Crash if typecode is -1.
-
-	* ste.c (ffeste_io_dolio_): Crash if typecode is -1.
-
-Sat Feb 11 09:51:57 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* ste.c: In I/O code tests for item arrayness, sort of revert
-	to much earlier code that tests original exp, but also check
-	in newer way just in case.  Newer way alone treated FOO(1:40)
-	as an array, not sure why older way alone didn't work, but I
-	think maybe it was when diagnosed code was involved, and
-	since there are now checks for error_mark_node, maybe the old
-	way alone would work.  But better to be safe; both original
-	ffebld exp _and_ the transformed tree must indicate an array
-	for the size-determination code to be used, else just 1/2 elements
-	assumed.  And this text is for EMACS: (foo at bar).
-
-Fri Feb 10 11:05:50 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* ste.c: In many cases, surround statement-expansion code
-	with ffecom_push_calltemps () and ffecom_pop_calltemps ()
-	so COMPLEX-returning functions can have temporaries pushed
-	in "auto-pop" mode and have them auto-popped at the end of
-	the statement.
-
-Wed Feb  8 14:35:10 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* runtime/f2c.h.in (ftnlen, ftnint): Make same size as integer.
-
-	* runtime/libI77/err.c (f_init): Thinko in MISSING_FILE_ELEMS
-	conditional.
-	* runtime/libI77/wrtfmt.c (mv_cur): Likewise.
-	* runtime/libI77/wsfe.c (x_putc): Likewise.
-
-	* runtime/libF77/signal_.c (signal_): Return 0 (this is a
-	subroutine).
-
-	* Makefile.in (f/proj.h): Depend on com.h.
-	* Make-lang.in (include/f2c.h): Likewise (and proj.h).
-	(install-libf77): Also install f2c.h.
-
-	* runtime/libI77/Makefile.in (*.o): Add f2c.h dependency.
-	* runtime/libF77/Makefile.in:  Likewise.
-
-Wed Feb  8 13:56:47 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* stc.c (ffestc_R501_item): Don't reset kind/where to NONE when
-	setting basictype/kindtype info for symbol, or especially
-	its function/result twin, because kind/where might not be NONE.
-
-Tue Feb  7 14:47:26 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in (include/f2c.h:): Set shell variable src more
-	robustly (independent of whether srcdir is relative or absolute).
-	* Makefile.in (f/proj.h:): Likewise.
-
-	* conf-proj.in: Check need for LAME_ASSERT.  Fix indentation in
-	check for LAME_STDIO (cosmetic only with ANSI C).
-
-	* com.h: Extra ...SIZE stuff taken from com.c.
-
-	* com.c (FFECOM_DETERMINE_TYPES): Define before including com.h.
-	(BITS_PER_WORD etc.) Remove and use conditional definitions to com.h.
-
-	* runtime/configure.in: #define FFECOM_DETERMINE_TYPES for com.h in
-	f2c type determination.
-
-	* tm.h: Remove (at least pro tem) because of relative path and use
-	top-level one.
-
-	* Make-lang.in (include/f2c.h:): Set shell variable src more
-	robustly (independent of whether srcdir is relative or absolute).
-	* Makefile.in (f/proj.h:): Likewise.
-
-Mon Feb  6 19:58:32 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* g77.c (append_arg): Use K&R declaration for, e.g. SunOS4 build.
-
-Fri Feb  3 20:33:14 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* g77.c (main): Treat -l like filename in terms of -x handling.
-	Rewrite arglist mechanism for ease of maintenance.
-	Make sure every -lf2c is followed by -lm and vice versa.
-
-	* Make-lang.in: Put complete list of sources in F77_SRCS def
-	so changing a .h file, for example, causes rebuild.
-
-	* Makefile.in: Change test for nextstep to m68k-next-nextstep* so
-	all versions of nextstep on m68k get the necessary flag.
-
-Fri Feb  3 19:10:32 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* INSTALL: Note about possible conflict with existing libf2c.a and
-	f2c.h.
-
-	* Make-lang.in (f77.distclean): Tidy and move deletion of
-	f/config.cache to mostlyclean.
-	(install-libf77): Test for $(libdir)/libf2c.* and barf if found
-	unless F2CLIBOK defined.
-
-	* runtime/Makefile.in (all): Change path to include directory (and
-	elsewhere).
-	(INCLUDES): Remove (unused/misleading).
-	(distclean): Include f2c.h.
-	(clean): Include config.cache.
-
-	* runtime/libF77/Makefile.in (.SUFFIXES): Correct typo.
-	(ALL_CFLAGS) Fix up include search path to find f2c.h in top level
-	includes always.
-	(all): Depend on f2c.h.
-	* runtime/libI77/Makefile.in (.SUFFIXES): Likewise.
-
-Thu Feb  2 17:17:06 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* INSTALL: Note about --srcdir and GNU make.
-
-	* runtime/f2c.h.in (Pad_UDread, ALWAYS_FLUSH): Reomve the #defines
-	per below.
-
-	* runtime/configure.in (Pad_UDread, ALWAYS_FLUSH): Define these
-	here, not in f2c.h as they'r eonly relevant for building.
-	* runtime/configure: Regenerated.
-
-	* config-lang.in: Warn about using GNU make outside source tree
-	since I can't get Irix5 or SunOS4 makes to work in this case.
-
-	* Makefile.in (VPATH): Don't set it here.
-	(srcdir): Make it the normal `.' (overridden) at top level.
-	(all.indirect): New dependency `dircheck'.
-	(f771): Likewise
-	(dircheck): New target for foolproofing.
-	(f/proj.h:): Change finding source.
-	(CONFIG_H): Don't use this as the relative path in the include loses
-	f builddir != srcdir.
-
-	* config.h: Remove per CONFIG_H change above.
-
-	* Make-lang.in (F77_FLAGS_TO_PASS): Remove GCC_FOR_TARGET.
-	(f771:): Pass VPATH, srcdir to sub-make.
-	(f/Makefile:): New target.
-	(stmp-int-hdrs): new variable for cheating build.
-	(f77-runtime:): Alter GCC_FOR_TARGET treatment.
-	(include/f2c.h f/runtime/Makefile:) Likewise.
-	(f77-runtime-unsafe:): New (cheating) target.
-
-Thu Feb  2 12:09:51 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* BUGS: Update regarding losing EQUIVALENCE members in -g, and
-	regarding RS/6000 problems in the back end.
-
-	* CREDITS: Make some changes as requested.
-
-	* com.c (ffecom_member_trunk_): Remove unused static variable.
-	(ffecom_finish_symbol_transform_): Improve comments.
-	(ffecom_let_char_): Fix size of temp address-type var.
-	(ffecom_member_phase2_): Try fixing problem fixed by change
-	to ffecom_transform_equiv_ (f_m_p2_ function currently not used).
-	(ffecom_transform_equiv_): Remove def of unused static variable.
-	Comment-out use of ffecom_member_phase2_, until problems with
-	back end fixed.
-	(ffecom_push_tempvar): Fix assertion to not crash okay code.
-
-	* com.h: Remove old, commented-out code.
-	Add prototype for warning() in back end.
-
-	* ste.c (ffeste_io_dofio_, ffeste_io_dolio_, ffeste_io_douio_,
-	ffeste_io_icilist_): Check correct type of variable for arrayness.
-
-Sun Jan 29 14:41:42 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* BUGS: Remove references to my configure bugs; add another.
-
-	* runtime/Makefile.in (AR_FLAGS): Provide default value.
-
-	* runtime/f2c.h.in (integer, logical): Take typedefs from
-	F2C_INTEGER configuration parameter again.
-	(NON_UNIX_STDIO): don't define it.
-
-	* runtime/configure.in: Bring type checks for f2c.h in line with
-	com.h.
-	(MISSING_FILE_ELEMS): New variable to determine whether the relevant
-	elements of the FILE struct exist, independent of NON_UNIX_STDIO.
-	* runtime/libI77/{err,wrtfmt,wsfe}.c (MISSING_FILE_ELEMS): Use new
-	parameter.
-
-	* config-lang.in: Comment out more of f2c rules (c.f. Make-lang.in).
-	(This stuff is relevant iff you gave configure --enable-f2c.)
-	Create f/runtime directory tree iff not building in source
-	directory.
-
-	* Makefile.in (srcdir): Append slash so we get the right value when
-	not building in the source directory.  This is a consequence of not
-	building the `f' sources in `f'.
-	(VPATH): Override configure's value for reasons above.
-	(f/proj.h f/conf-proj): New rules to build proj.h by
-	autoconfiguration.
-
-	* proj.h: Rename to proj.h.in for autoconfiguration.
-	* proj.h.in: New as above.
-	* conf-proj conf-proj.in: New files for autoconfiguration.
-
-	* Make-lang.in (include/f2c.h f/runtime/Makefile:): Change the order
-	of setting the sh variables so that the right GCC_FOR_TARGET is
-	used.
-	(f77.*clean:) Add products of new configuration files and make sure
-	all the *clean targets do something (unlike the ones in
-	cp/Make-lange.in).
-
-	* com.h (FFECOM_f2cINTEGER, FFECOM_f2cLOGICAL): Define as long or
-	int appropriately to ensure sizeof(real) == sizeof(integer).
-
-	* PROJECTS: Library section.
-
-	* runtime/libI77/endfile.c: Don't #include sys/types.h conditional
-	on NON_UNIX_STDIO since rawio.h needs size_t.
-	* runtime/libI77/uio.c: #include <sys/types.h> for size_t if not
-	KR_headers.
-
-Wed Jan 25 03:31:51 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.3 released.
-
-	* INSTALL: Revise.
-
-	* Make-lang.in: Comment out rules for building f2c itself (f/f2c/).
-
-	* README: Revise.
-
-	* com.c (ffecom_init_0): Warn if ftnlen or INTEGER not big enough
-	to hold a char *.
-
-	* gbe/2.6.2.diff: Update.
-
-Mon Jan 23 17:10:49 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* TODO: Remove.
-	BUGS: New file.
-	PROJECTS: New file.
-	CREDITS: New file.
-
-	* cktyps*: Remove.
-	Make-lang.in: Remove cktyps stuff.
-	Makefile.in: Remove cktyps stuff.
-
-	* DOC: Add info on changes for 0.5.3.
-
-	* bad.c: Put "warning:" &c on diagnostic messages.
-	Don't output informational messages if warnings disabled.
-
-Thu Jan 19 12:38:13 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* g77.c: Avoid putting out useless "-xnone -xf77" pairs so
-	larger command lines can be accommodated.
-	Recognize both `-xlang' and `-x lang'.
-	Recognize `-xnone' and `-x none' to mean what it does, instead
-	of treating "none" as any other language.
-	Some minor, slight improvements in the way args are handled
-	(hopefully for clearer, more maintainable code), including
-	consistency checks on arg count just in case.
-
-Wed Jan 18 16:41:57 1995  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* DOC: Explain -fautomatic better.
-
-	* INSTALL: Describe libf2c.a better.
-
-	* Make-lang.in, Makefile.in: Build f771 &c with gcc/ as cd instead
-	of gcc/f/ so debugging info is better (source file tracking).
-	Add new source file type.c.
-
-	* Makefile.in: For nextstep3, link f771 with -segaddr __DATA
-	6000000.  Fix typo.  Change deps-kinda target to handle building
-	from gcc/.  Update dependencies.
-
-	* bld-op.def, bld.h, bld.c: Remove opBACKEND and all related
-	stuff.
-	Remove consistency tests that cause compiler warnings.
-
-	* cktyps.c: Remove all typing checking.
-
-	* com-rt.def: Change all rttypeFLOAT_ intrinsics to rttypeDOUBLE_,
-	to precisely match how they're declared in libf2c.
-
-	* com.h, com.c: Revise to more elegantly track related stuff
-	in the version of f2c.h used to build libf2c.
-
-	* com.c: Increase FFECOM_sizeMAXSTACKITEM, and if 0 or undefined
-	when checked to determine where to put entity, treat as infinite.
-	Rewrite temporary mechanism to be based on trees instead of
-	ffeinfo stuff, and make it much simpler.  Change interface
-	accordingly.
-	Fixes to better track types of things, make appropriate
-	conversions, etc.  E.g. when making an arg for a libf2c
-	function, make sure it's of the right type (such as ftnlen).
-	Delete opBACKEND transformation code.
-	(ffecom_init_0): Smoother initialization of types, especially
-	paying attention to using consistent rules for making INTEGER,
-	REAL, DOUBLE PRECISION, etc., and for deciding their "*N"
-	and kind values that will work across all g77 platforms.
-	No longer require per-target configuration info in target.h
-	or config/*/*; use new type module to store size, alignment.
-	(ffecom_member_phase2): Declare COMMON/EQUIVALENCE group members
-	so debugger sees them.
-	(ffecom_finish_progunit): Transform all symbols in program unit,
-	so -g will show they all exist.
-
-	* expr.c (ffeexpr_collapse_substr): Handle strange substring
-	range values.
-
-	* info.h, info.c: Provide connection to new type module.
-	Remove tests that yield compiler warnings.
-
-	* intrin.c (ffeintrin_is_intrinsic): Properly handle deleted
-	intrinsic.
-
-	* lex.c (ffelex_file_fixed): Remove redundant/buggy code.
-
-	* stc.c (ffestc_kindtype_kind_, ffestc_kindtype_star_): Replace
-	boring switch stmt with simple call to new type module.  This
-	sort of thing is a reason to get up in the morning.
-
-	* ste.c: Update to handle new interface for
-	ffecom_push/pop_tempvar.
-	Fixes to better track types of things.
-	Fixes to not crash for certain diagnosed constructs.
-	(ffeste_begin_iterdo_): Check only constants for overflow to avoid
-	spurious diagnostics.
-	Don't convert larger integer (say, INTEGER*8) to canonical integer
-	for iteration count.
-
-	* stw.h: Track DO iteration count temporary variable.
-
-	* symbol.c: Remove consistency tests that cause compiler warnings.
-
-	* target.c (ffetarget_aggregate_info): Replace big switch with
-	little call to new type module.
-	(ffetarget_layout): Remove consistency tests that cause
-	compiler warnings.
-	(ffetarget_convert_character1_typeless): Pick up length of
-	typeless type from new type module.
-
-	* target.h: Crash build if target float bit pattern cannot be
-	precisely determined.
-	Remove all the type cruft now determined by ffecom_init_0
-	at invocation time and maintained in new type module.
-	Put casts on second arg of all REAL_VALUE_TO_TARGET_DOUBLE
-	uses so compiler warnings avoided (requires target float bit
-	pattern to be precisely determined, hence code to crash build).
-
-	* top.c: Add inits/terminates for new type module.
-
-	* type.h, type.c: New module.
-
-	* gbe/2.6.2.diff: Remove all patches to files in gcc/config/
-	directory and its subdirectories.
-
-Mon Jan  9 19:23:25 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* com.h (FFECOM_F2C_INTEGER_TYPE_NODE): Define and use instead of
-	long_integer_type_node where appropriate.
-
-Tue Jan  3 14:56:18 1995  Dave Love  <d.love@dl.ac.uk>
-
-	* com.h: Make ffecom_f2c_logical_type_node long, consistent with
-	integer.
-
-Fri Dec  2 20:07:37 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* config-lang.in (stagestuff): Add f2c conditionally.
-	* Make-lang.in: Add f2c and related targets.
-	* f2c: Add the directory.
-
-Fri Nov 25 22:17:26 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* Makefile.in (FLAGS_TO_PASS): pass $(CROSS)
-	* Make-lang.in: more changes to runtime targets
-
-Thu Nov 24 18:03:21 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* Makefile.in (FLAGS_TO_PASS): define for sub-makes
-
-	* g77.c (main): change f77-cpp-output to f77-cpp-input (.F files)
-
-Wed Nov 23 15:22:53 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* bad.c (ffebad_finish): kluge to fool emacs19 into finding errors:
-	add trailing space to <file>:<line>:
-
-Tue Nov 22 11:30:50 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* runtime/libF77/signal_.c (RETSIGTYPE): added
-
-Mon Nov 21 13:04:13 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* Makefile.in (compiler): add runtime
-
-	* config-lang.in (stagestuff): add libf2c.a to stagestuff
-
-	* Make-lang.in:
-	G77STAGESTUFF <- MORESTAGESTUFF
-	f77-runtime: new target, plus supporting ones
-
-	* runtime: add the directory, containing libI77, libF77 and autoconf
-	stuff
-
-	* g++.1: remove
-
-	* g77.1: minor fixes
-
-Thu Nov 17 15:18:05 1994  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.2 released.
-
-	* bad.def: Modify wording of FFEBAD_UNIMPL_STMT to indicate
-	that it covers a wide array of possible problems (that, someday,
-	should be handled via separate diagnostics).
-
-	* lex.c: Allow $ in identifiers if -fdollar-ok.
-	* top.c: Support -fdollar-ok.
-	* top.h: Support -fdollar-ok.
-	* target.h: Support -fdollar-ok.
-	* DOC: Describe -fdollar-ok.
-
-	* std.c (ffestd_R1229_finish): Fix bug so stand-alone build works.
-	* ste.c (ffeste_R819A): Fix bug so stand-alone build works.
-
-	* Make: Improvements for stand-alone build.
-
-	* Makefile.in: Fix copyright text at top of file.
-
-	* LINK, SRCS, UNLINK: Removed.  Not particularly useful now that
-	g77 sources live in their own subdirectory.
-
-	* g77.c (main): Cast arg to bzero to avoid warning.  (This is
-	identical to Kenner's fix to cp/g++.c.)
-
-	* gbe/: New subdirectory, to contain .diff files for various
-	versions of the GNU CC back end.
-
-	* gbe/README: New file.
-	* gbe/2.6.2.diff: New file.
-
-Tue Nov  8 10:23:10 1994  Dave Love  <d.love@dl.ac.uk>
-
-	* Make-lang.in: don't install as f77 as well as g77 to avoid
-	confusion with system's compiler (especially while testing)
-
-	* g77.c (main): use -lf2c and -lm; fix sense of test for .f/.F files
-
-Fri Oct 28 09:45:00 1994  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.1 released.
-
-	* gcc.c: Invoke f771 instead of f-771.
-
-Fri Oct 28 02:00:44 1994  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Version 0.5.0 released.
-
-Fri Oct 14 15:03:35 1994  Craig Burley  (burley@gnu.ai.mit.edu)
-
-	* Makefile.in: Handle the Fortran-77 front-end in a subdirectory.
-	* f-*: Move Fortran-77 front-end to f/*.
-
-Local Variables:
-add-log-time-format: current-time-string
-End:
diff --git a/gcc/f/ChangeLog.tree-ssa b/gcc/f/ChangeLog.tree-ssa
deleted file mode 100644
index 783ebaa..0000000
--- a/gcc/f/ChangeLog.tree-ssa
+++ /dev/null
@@ -1,21 +0,0 @@
-2003-11-16  Toon Moene  <toon@moene.indiv.nluug.nl>
-
-	* config-lang.in: Re-add.
-
-2003-10-26  Richard Henderson  <rth@redhat.com>
-
-	* config-lang.in: Remove.
-
-2003-09-24  Jason Merrill  <jason@redhat.com>
-
-	* com.c, ste.c: Revert earlier change.
-
-2003-01-15  Jeff Law <law@redhat.com>
-
-	* com.c (duplicate_decls): Use TREE_FILENAME and TREE_LINENO
-	to extract file/line information from nodes.  Use TREE_LOCUS
-	to copy file/line information from one node to another.
-	Make sure to copy TREE_LOCUS from the old decl to the new decl.
-	(pushdecl): Similarly.
-	* ste.c: Likewise.
-
diff --git a/gcc/f/Make-lang.in b/gcc/f/Make-lang.in
deleted file mode 100644
index 80c870c..0000000
--- a/gcc/f/Make-lang.in
+++ /dev/null
@@ -1,545 +0,0 @@
-# Top level -*- makefile -*- fragment for GNU Fortran.
-#   Copyright (C) 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003, 2004
-#   Free Software Foundation, Inc.
-
-#This file is part of GNU Fortran.
-
-#GNU Fortran 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.
-
-#GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-#the Free Software Foundation, 59 Temple Place - Suite 330,
-#Boston, MA 02111-1307, USA.
-
-# This file provides the language dependent support in the main Makefile.
-# Each language makefile fragment must provide the following targets:
-#
-# foo.all.build, foo.all.cross, foo.start.encap, foo.rest.encap,
-# foo.install-normal, foo.install-common, foo.install-man,
-# foo.uninstall,
-# 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.
-#
-# It should also provide rules for:
-#
-# - making any compiler driver (eg: g++)
-# - the compiler proper (eg: cc1plus)
-# - define the names for selecting the language in LANGUAGES.
-#
-# $(srcdir) must be set to the gcc/ source directory (not gcc/f/).
-#
-# Actual name to use when installing a native compiler.
-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'
-# in the kernel.  So, we use `echo' instead. 
-STAMP = echo timestamp >
-
-#
-# Define the names for selecting f77 in LANGUAGES.
-# Note that it would be nice to move the dependency on g77
-# into the F77 rule, but that needs a little bit of work
-# to do the right thing within all.cross.
-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.dvi \
-  f77.install-normal \
-  f77.install-common f77.install-man \
-  f77.uninstall f77.mostlyclean f77.clean f77.distclean \
-  f77.maintainer-clean \
-  f77.stage1 f77.stage2 f77.stage3 f77.stage4 \
-  f77.stageprofile f77.stagefeedback
-
-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) \
-		$(INCLUDES) $(srcdir)/f/g77spec.c)
-
-# Create the compiler driver for g77.
-g77$(exeext): gcc.o g77spec.o version.o prefix.o intl.o \
-  $(LIBDEPS) $(EXTRA_GCC_OBJS)
-	$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ gcc.o g77spec.o \
-	   version.o prefix.o intl.o $(EXTRA_GCC_OBJS) $(LIBS)
-
-# Create a version of the g77 driver which calls the cross-compiler.
-g77-cross$(exeext): g77$(exeext)
-	rm -f g77-cross$(exeext); \
-	cp g77$(exeext) g77-cross$(exeext)
-
-# The compiler itself.
-
-F77_OBJS = f/bad.o f/bit.o f/bld.o f/com.o f/data.o f/equiv.o f/expr.o \
- f/global.o f/implic.o f/info.o f/intrin.o f/lab.o f/lex.o f/malloc.o \
- f/name.o f/parse.o f/src.o f/st.o f/sta.o f/stb.o f/stc.o \
- f/std.o f/ste.o f/storag.o f/stp.o f/str.o f/sts.o f/stt.o f/stu.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 = $(WERROR)
-
-f771$(exeext): $(F77_OBJS) $(BACKEND) $(LIBDEPS)
-	rm -f f771$(exeext)
-	$(CC) $(ALL_CFLAGS) $(LDFLAGS) -o $@ $(F77_OBJS) $(BACKEND) $(LIBS)
-
-# Keyword tables.
-f/stamp-str: f/str-1t.h f/str-1t.j f/str-2t.h f/str-2t.j \
- f/str-fo.h f/str-fo.j f/str-io.h f/str-io.j f/str-nq.h  f/str-nq.j \
- f/str-op.h f/str-op.j f/str-ot.h f/str-ot.j
-	$(STAMP) f/stamp-str
-
-f/str-1t.h f/str-1t.j: f/stamp-1t ; @true
-f/stamp-1t: f/fini$(build_exeext) f/str-1t.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-1t.fin f/tmp-str-1t.j f/tmp-str-1t.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-1t.j f/str-1t.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-1t.h f/str-1t.h
-	$(STAMP) f/stamp-1t
-
-f/str-2t.h f/str-2t.j: f/stamp-2t ; @true
-f/stamp-2t: f/fini$(build_exeext) f/str-2t.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-2t.fin f/tmp-str-2t.j f/tmp-str-2t.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-2t.j f/str-2t.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-2t.h f/str-2t.h
-	$(STAMP) f/stamp-2t
-
-f/str-fo.h f/str-fo.j: f/stamp-fo ; @true
-f/stamp-fo: f/fini$(build_exeext) f/str-fo.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-fo.fin f/tmp-str-fo.j f/tmp-str-fo.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-fo.j f/str-fo.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-fo.h f/str-fo.h
-	$(STAMP) f/stamp-fo
-
-f/str-io.h f/str-io.j: f/stamp-io ; @true
-f/stamp-io: f/fini$(build_exeext) f/str-io.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-io.fin f/tmp-str-io.j f/tmp-str-io.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-io.j f/str-io.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-io.h f/str-io.h
-	$(STAMP) f/stamp-io
-
-f/str-nq.h f/str-nq.j: f/stamp-nq ; @true
-f/stamp-nq: f/fini$(build_exeext) f/str-nq.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-nq.fin f/tmp-str-nq.j f/tmp-str-nq.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-nq.j f/str-nq.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-nq.h f/str-nq.h
-	$(STAMP) f/stamp-nq
-
-f/str-op.h f/str-op.j: f/stamp-op ; @true
-f/stamp-op: f/fini$(build_exeext) f/str-op.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-op.fin f/tmp-str-op.j f/tmp-str-op.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-op.j f/str-op.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-op.h f/str-op.h
-	$(STAMP) f/stamp-op
-
-f/str-ot.h f/str-ot.j: f/stamp-ot ; @true
-f/stamp-ot: f/fini$(build_exeext) f/str-ot.fin
-	./f/fini$(build_exeext) $(srcdir)/f/str-ot.fin f/tmp-str-ot.j f/tmp-str-ot.h
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-ot.j f/str-ot.j
-	$(SHELL) $(srcdir)/../move-if-change f/tmp-str-ot.h f/str-ot.h
-	$(STAMP) f/stamp-ot
-
-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:
-	$(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
-
-#
-# Build hooks:
-
-f77.all.build: g77$(exeext)
-f77.all.cross: g77-cross$(exeext)
-f77.start.encap: g77$(exeext)
-f77.rest.encap:
-
-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.
-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
-
-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
-# so ANSI C compilers can compile f/intdoc.h -- gcc can compile f/intdoc.in
-# directly, if f/intdoc.c #include'd that, but we don't want to force
-# people to install gcc just to build the documentation.  We use the
-# C format for f/intdoc.in in the first place to allow a fairly "free",
-# but widely known format for documentation -- basically anyone who knows
-# how to write texinfo source and enclose it in C constants can handle
-# it, and f/ansify allows them to not even end lines with "\n\".  So,
-# essentially, the C preprocessor and compiler are used to enter the
-# document snippets into a data base via name lookup, rather than duplicating
-# that kind of code here.  And we use f/intdoc.c instead of straight
-# texinfo in the first place so that as much information as possible
-# contained in f/intrin.def can be inserted directly and reliably into
-# the documentation.  That's better than replicating it, because it
-# reduces the likelihood of discrepancies between the docs and the compiler
-# itself, which uses f/intrin.def; in fact, many bugs in f/intrin.def have
-# been found only upon reading the documentation that was automatically
-# produced from it.
-
-# 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 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 = f/intdoc.c f/intrin.h f/intrin.def
-
-$(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 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) $< < $< > $@
-
-f/ansify$(build_exeext): f/ansify.c bconfig.h $(SYSTEM_H) coretypes.h $(TM_H)
-	  $(CC_FOR_BUILD) $(BUILD_CFLAGS) $(BUILD_LDFLAGS) $(INCLUDES) $< \
-	  -o $@
-
-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
-
-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:
-# f771 is installed elsewhere as part of $(COMPILERS).
-
-f77.install-normal:
-
-# Install the driver program as $(target)-g77
-# and also as either g77 (if native) or $(tooldir)/bin/g77.
-f77.install-common: installdirs
-	-if [ -f f771$(exeext) ] ; then \
-	  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 ''; \
-	  echo 'Warning: gcc no longer installs an f77 command.'; \
-	  echo '         You must do so yourself.  For more information,'; \
-	  echo '         read "Distributing Binaries" in the g77 docs.'; \
-	  echo '         (To turn off this warning, delete the file'; \
-	  echo '         f77-install-ok in the source or build directory.)'; \
-	  echo ''; \
-	else true; fi
-
-install-info:: $(DESTDIR)$(infodir)/g77.info
-
-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 \
-	  echo " install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info"; \
-	  install-info --delete --info-dir=$(DESTDIR)$(infodir) $(DESTDIR)$(infodir)/g77.info || : ; \
-	else : ; fi
-	rm -rf $(DESTDIR)$(bindir)/$(G77_INSTALL_NAME)$(exeext); \
-	rm -rf $(DESTDIR)$(man1dir)/$(G77_INSTALL_NAME)$(man1ext); \
-	rm -rf $(DESTDIR)$(infodir)/g77.info*
-#
-# Clean hooks:
-# A lot of the ancillary files are deleted by the main makefile.
-# We just have to delete files specific to us.
-
-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/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.maintainer-clean:
-	-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.
-
-G77STAGESTUFF = f/*$(objext) f/fini$(build_exeext) f/stamp-* \
-  f/str-*.h f/str-*.j g77spec.o
-
-f77.stage1: stage1-start
-	-mv -f $(G77STAGESTUFF) stage1/f
-
-f77.stage2: stage2-start
-	-mv -f $(G77STAGESTUFF) stage2/f
-
-f77.stage3: stage3-start
-	-mv -f $(G77STAGESTUFF) stage3/f
-
-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.
-
-f/bad.o: f/bad.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 flags.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/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 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 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 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 \
- coretypes.h $(TM_H) function.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 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 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 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 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 \
- 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 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 \
- 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 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 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 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 \
- 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 \
- 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 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/gcc/f/RELEASE-PREP b/gcc/f/RELEASE-PREP
deleted file mode 100644
index 71eebf6..0000000
--- a/gcc/f/RELEASE-PREP
+++ /dev/null
@@ -1,5 +0,0 @@
-1999-03-13  RELEASE-PREP
-
-Things to do to prepare a g77 release.
-
--  Update root.texi: clear DEVELOPMENT flag, set version info.
diff --git a/gcc/f/ansify.c b/gcc/f/ansify.c
deleted file mode 100644
index b03206d79..0000000
--- a/gcc/f/ansify.c
+++ /dev/null
@@ -1,190 +0,0 @@
-/* ansify.c
-   Copyright (C) 1997, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 "bconfig.h"
-#include "system.h"
-#include "coretypes.h"
-#include "tm.h"
-
-#define die_unless(c) \
-  do if (!(c)) \
-    { \
-      fprintf (stderr, "%s:%lu: %s\n", argv[1], lineno, #c); \
-      die (); \
-    } \
-  while(0)
-
-static void ATTRIBUTE_NORETURN
-die (void)
-{
-  exit (1);
-}
-
-int
-main(int argc, char **argv)
-{
-  int c;
-  static unsigned long lineno = 1;
-
-  die_unless (argc == 2);
-
-  printf ("\
-/* This file is automatically generated from `%s',\n\
-   which you should modify instead.  */\n\
-#line 1 \"%s\"\n\
-",
-	  argv[1], argv[1]);
-
-  while ((c = getchar ()) != EOF)
-    {
-      switch (c)
-	{
-	default:
-	  putchar (c);
-	  break;
-
-	case '\n':
-	  ++lineno;
-	  putchar (c);
-	  break;
-
-	case '"':
-	  putchar (c);
-	  for (;;)
-	    {
-	      c = getchar ();
-	      die_unless (c != EOF);
-	      switch (c)
-		{
-		case '"':
-		  putchar (c);
-		  goto next_char;
-
-		case '\n':
-		  putchar ('\\');
-		  putchar ('n');
-		  putchar ('\\');
-		  putchar ('\n');
-		  ++lineno;
-		  break;
-
-		case '\\':
-		  putchar (c);
-		  c = getchar ();
-		  die_unless (c != EOF);
-		  putchar (c);
-		  if (c == '\n')
-		    ++lineno;
-		  break;
-		  
-		default:
-		  putchar (c);
-		  break;
-		}
-	    }
-	  break;
-
-	case '\'':
-	  putchar (c);
-	  for (;;)
-	    {
-	      c = getchar ();
-	      die_unless (c != EOF);
-	      switch (c)
-		{
-		case '\'':
-		  putchar (c);
-		  goto next_char;
-		  
-		case '\n':
-		  putchar ('\\');
-		  putchar ('n');
-		  putchar ('\\');
-		  putchar ('\n');
-		  ++lineno;
-		  break;
-		  
-		case '\\':
-		  putchar (c);
-		  c = getchar ();
-		  die_unless (c != EOF);
-		  putchar (c);
-		  if (c == '\n')
-		    ++lineno;
-		  break;
-		  
-		default:
-		  putchar (c);
-		  break;
-		}
-	    }
-	  break;
-
-	case '/':
-	  putchar (c);
-	  c = getchar ();
-	  putchar (c);
-	  if (c != '*')
-	    break;
-	  for (;;)
-	    {
-	      c = getchar ();
-	      die_unless (c != EOF);
-
-	      switch (c)
-		{
-		case '\n':
-		  ++lineno;
-		  putchar (c);
-		  break;
-		  
-		case '*':
-		  c = getchar ();
-		  die_unless (c != EOF);
-		  if (c == '/')
-		    {
-		      putchar ('*');
-		      putchar ('/');
-		      goto next_char;
-		    }
-		  if (c == '\n')
-		    {
-		      ++lineno;
-		      putchar (c);
-		    }
-		  break;
-		  
-		default:
-		  /* Don't bother outputting content of comments.  */
-		  break;
-		}
-	    }
-	  break;
-	}
-      
-    next_char:
-      ;
-    }
-
-  die_unless (c == EOF);
-
-  return 0;
-}
diff --git a/gcc/f/bad.c b/gcc/f/bad.c
deleted file mode 100644
index bed9734..0000000
--- a/gcc/f/bad.c
+++ /dev/null
@@ -1,537 +0,0 @@
-/* bad.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Handles the displaying of diagnostic messages regarding the user's source
-      files.
-
-   Modifications:
-*/
-
-/* If there's a %E or %4 in the messages, set this to at least 5,
-   for example.  */
-
-#define FFEBAD_MAX_ 6
-
-/* Include files. */
-
-#include "proj.h"
-#include "bad.h"
-#include "flags.h"
-#include "com.h"
-#include "toplev.h"
-#include "where.h"
-#include "intl.h"
-#include "diagnostic.h"
-
-/* Externals defined here. */
-
-bool ffebad_is_inhibited_ = FALSE;
-
-/* Simple definitions and enumerations. */
-
-#define FFEBAD_LONG_MSGS_ 1	/* 0 to use short (or same) messages. */
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffebad_message_
-  {
-    const ffebadSeverity severity;
-    const char *const message;
-  };
-
-/* Static objects accessed by functions in this module.	 */
-
-static const struct _ffebad_message_ ffebad_messages_[]
-=
-{
-#define FFEBAD_MSG(kwd,sev,msgid) { sev, msgid },
-#if FFEBAD_LONG_MSGS_ == 0
-#define LONG(m)
-#define SHORT(m) m
-#else
-#define LONG(m) m
-#define SHORT(m)
-#endif
-#include "bad.def"
-#undef FFEBAD_MSG
-#undef LONG
-#undef SHORT
-};
-
-static struct
-  {
-    ffewhereLine line;
-    ffewhereColumn col;
-    ffebadIndex tag;
-  }
-
-ffebad_here_[FFEBAD_MAX_];
-static const char *ffebad_string_[FFEBAD_MAX_];
-static ffebadIndex ffebad_order_[FFEBAD_MAX_];
-static ffebad ffebad_errnum_;
-static ffebadSeverity ffebad_severity_;
-static const char *ffebad_message_;
-static unsigned char ffebad_index_;
-static ffebadIndex ffebad_places_;
-static bool ffebad_is_temp_inhibited_;	/* Effective setting of
-					   _is_inhibited_ for this
-					   _start/_finish invocation. */
-
-/* Static functions (internal). */
-
-static int ffebad_bufputs_ (char buf[], int bufi, const char *s);
-
-/* Internal macros. */
-
-#define ffebad_bufflush_(buf, bufi) \
-  (((buf)[bufi] = '\0'), fputs ((buf), stderr), 0)
-#define ffebad_bufputc_(buf, bufi, c) \
-  (((bufi) == ARRAY_SIZE (buf)) \
-   ? (ffebad_bufflush_ ((buf), (bufi)), ((buf)[0] = (c)), 1) \
-   : (((buf)[bufi] = (c)), (bufi) + 1))
-
-
-static int
-ffebad_bufputs_ (char buf[], int bufi, const char *s)
-{
-  for (; *s != '\0'; ++s)
-    bufi = ffebad_bufputc_ (buf, bufi, *s);
-  return bufi;
-}
-
-/* ffebad_init_0 -- Initialize
-
-   ffebad_init_0();  */
-
-void
-ffebad_init_0 (void)
-{
-  assert (FFEBAD == ARRAY_SIZE (ffebad_messages_));
-}
-
-ffebadSeverity
-ffebad_severity (ffebad errnum)
-{
-  return ffebad_messages_[errnum].severity;
-}
-
-/* ffebad_start_ -- Start displaying an error message
-
-   ffebad_start(FFEBAD_SOME_ERROR_CODE);
-
-   Call ffebad_start to establish the message, ffebad_here and ffebad_string
-   to send run-time data to it as necessary, then ffebad_finish when through
-   to actually get it to print (to stderr).
-
-   Note: ffebad_start(errnum) turns into ffebad_start_(FALSE,errnum).  No
-   outside caller should call ffebad_start_ directly (as indicated by the
-   trailing underscore).
-
-   Call ffebad_start to start a normal message, one that might be inhibited
-   by the current state of statement guessing.	Call ffebad_start_lex
-   instead to start a message that is global to all statement guesses and
-   happens only once for all guesses (i.e. the lexer).
-
-   sev and message are overrides for the severity and messages when errnum
-   is FFEBAD, meaning the caller didn't want to have to put a message in
-   bad.def to produce a diagnostic.  */
-
-bool
-ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
-	       const char *msgid)
-{
-  unsigned char i;
-
-  if (ffebad_is_inhibited_ && !lex_override)
-    {
-      ffebad_is_temp_inhibited_ = TRUE;
-      return FALSE;
-    }
-
-  if (errnum != FFEBAD)
-    {
-      ffebad_severity_ = ffebad_messages_[errnum].severity;
-      ffebad_message_ = gettext (ffebad_messages_[errnum].message);
-    }
-  else
-    {
-      ffebad_severity_ = sev;
-      ffebad_message_ = gettext (msgid);
-    }
-
-  switch (ffebad_severity_)
-    {				/* Tell toplev.c about this message. */
-    case FFEBAD_severityINFORMATIONAL:
-    case FFEBAD_severityTRIVIAL:
-      if (inhibit_warnings)
-	{			/* User wants no warnings. */
-	  ffebad_is_temp_inhibited_ = TRUE;
-	  return FALSE;
-	}
-      /* Fall through.  */
-    case FFEBAD_severityWARNING:
-    case FFEBAD_severityPECULIAR:
-    case FFEBAD_severityPEDANTIC:
-      if ((ffebad_severity_ != FFEBAD_severityPEDANTIC)
-	  || !flag_pedantic_errors)
-	{
-	  if (!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).  */
-    case FFEBAD_severityFATAL:
-    case FFEBAD_severityWEIRD:
-    case FFEBAD_severitySEVERE:
-    case FFEBAD_severityDISASTER:
-      diagnostic_kind_count (global_dc, DK_ERROR)++;
-      break;
-
-    default:
-      break;
-    }
-
-  ffebad_is_temp_inhibited_ = FALSE;
-  ffebad_errnum_ = errnum;
-  ffebad_index_ = 0;
-  ffebad_places_ = 0;
-  for (i = 0; i < FFEBAD_MAX_; ++i)
-    {
-      ffebad_string_[i] = NULL;
-      ffebad_here_[i].line = ffewhere_line_unknown ();
-      ffebad_here_[i].col = ffewhere_column_unknown ();
-    }
-
-  return TRUE;
-}
-
-/* ffebad_here -- Establish source location of some diagnostic concern
-
-   ffebad_here(ffebadIndex i,ffewhereLine line,ffewhereColumn col);
-
-   Call ffebad_start to establish the message, ffebad_here and ffebad_string
-   to send run-time data to it as necessary, then ffebad_finish when through
-   to actually get it to print (to stderr).  */
-
-void
-ffebad_here (ffebadIndex index, ffewhereLine line, ffewhereColumn col)
-{
-  ffewhereLineNumber line_num;
-  ffewhereLineNumber ln;
-  ffewhereColumnNumber col_num;
-  ffewhereColumnNumber cn;
-  ffebadIndex i;
-  ffebadIndex j;
-
-  if (ffebad_is_temp_inhibited_)
-    return;
-
-  assert (index < FFEBAD_MAX_);
-  ffebad_here_[index].line = ffewhere_line_use (line);
-  ffebad_here_[index].col = ffewhere_column_use (col);
-  if (ffewhere_line_is_unknown (line)
-      || ffewhere_column_is_unknown (col))
-    {
-      ffebad_here_[index].tag = FFEBAD_MAX_;
-      return;
-    }
-  ffebad_here_[index].tag = 0;	/* For now, though it shouldn't matter. */
-
-  /* Sort the source line/col points into the order they occur in the source
-     file.  Deal with duplicates appropriately. */
-
-  line_num = ffewhere_line_number (line);
-  col_num = ffewhere_column_number (col);
-
-  /* Determine where in the ffebad_order_ array this new place should go. */
-
-  for (i = 0; i < ffebad_places_; ++i)
-    {
-      ln = ffewhere_line_number (ffebad_here_[ffebad_order_[i]].line);
-      cn = ffewhere_column_number (ffebad_here_[ffebad_order_[i]].col);
-      if (line_num < ln)
-	break;
-      if (line_num == ln)
-	{
-	  if (col_num == cn)
-	    {
-	      ffebad_here_[index].tag = i;
-	      return;		/* Shouldn't go in, has equivalent. */
-	    }
-	  else if (col_num < cn)
-	    break;
-	}
-    }
-
-  /* Before putting new place in ffebad_order_[i], first increment all tags
-     that are i or greater. */
-
-  if (i != ffebad_places_)
-    {
-      for (j = 0; j < FFEBAD_MAX_; ++j)
-	{
-	  if (ffebad_here_[j].tag >= i)
-	    ++ffebad_here_[j].tag;
-	}
-    }
-
-  /* Then slide all ffebad_order_[] entries at and above i up one entry. */
-
-  for (j = ffebad_places_; j > i; --j)
-    ffebad_order_[j] = ffebad_order_[j - 1];
-
-  /* Finally can put new info in ffebad_order_[i]. */
-
-  ffebad_order_[i] = index;
-  ffebad_here_[index].tag = i;
-  ++ffebad_places_;
-}
-
-/* Establish string for next index (always in order) of message
-
-   ffebad_string(const char *string);
-
-   Call ffebad_start to establish the message, ffebad_here and ffebad_string
-   to send run-time data to it as necessary, then ffebad_finish when through
-   to actually get it to print (to stderr).  Note: don't trash the string
-   until after calling ffebad_finish, since we just maintain a pointer to
-   the argument passed in until then.  */
-
-void
-ffebad_string (const char *string)
-{
-  if (ffebad_is_temp_inhibited_)
-    return;
-
-  assert (ffebad_index_ != FFEBAD_MAX_);
-  ffebad_string_[ffebad_index_++] = string;
-}
-
-/* ffebad_finish -- Display error message with where & run-time info
-
-   ffebad_finish();
-
-   Call ffebad_start to establish the message, ffebad_here and ffebad_string
-   to send run-time data to it as necessary, then ffebad_finish when through
-   to actually get it to print (to stderr).  */
-
-void
-ffebad_finish (void)
-{
-#define MAX_SPACES 132
-  static const char *const spaces
-  = "...>\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\040\
-\040\040\040";			/* MAX_SPACES - 1 spaces. */
-  ffewhereLineNumber last_line_num;
-  ffewhereLineNumber ln;
-  ffewhereLineNumber rn;
-  ffewhereColumnNumber last_col_num;
-  ffewhereColumnNumber cn;
-  ffewhereColumnNumber cnt;
-  ffewhereLine l;
-  ffebadIndex bi;
-  unsigned short i;
-  char pointer;
-  unsigned char c;
-  unsigned const char *s;
-  const char *fn;
-  static char buf[1024];
-  int bufi;
-  int index;
-
-  if (ffebad_is_temp_inhibited_)
-    return;
-
-  switch (ffebad_severity_)
-    {
-    case FFEBAD_severityINFORMATIONAL:
-      s = _("note:");
-      break;
-
-    case FFEBAD_severityWARNING:
-      s = _("warning:");
-      break;
-
-    case FFEBAD_severitySEVERE:
-      s = _("fatal:");
-      break;
-
-    default:
-      s = "";
-      break;
-    }
-
-  /* Display the annoying source references. */
-
-  last_line_num = 0;
-  last_col_num = 0;
-
-  for (bi = 0; bi < ffebad_places_; ++bi)
-    {
-      if (ffebad_places_ == 1)
-	pointer = '^';
-      else
-	pointer = '1' + bi;
-
-      l = ffebad_here_[ffebad_order_[bi]].line;
-      ln = ffewhere_line_number (l);
-      rn = ffewhere_line_filelinenum (l);
-      cn = ffewhere_column_number (ffebad_here_[ffebad_order_[bi]].col);
-      fn = ffewhere_line_filename (l);
-      if (ln != last_line_num)
-	{
-	  if (bi != 0)
-	    fputc ('\n', stderr);
-	  diagnostic_report_current_function (global_dc);
-	  fprintf (stderr,
-		   /* the trailing space on the <file>:<line>: line
-		      fools emacs19 compilation mode into finding the
-		      report */
-		   "%s:%" ffewhereLineNumber_f "u: %s\n   %s\n   %s%c",
-		   fn, rn,
-		   s,
-		   ffewhere_line_content (l),
-		   &spaces[cn > MAX_SPACES ? 0 : MAX_SPACES - cn + 4],
-		   pointer);
-	  last_line_num = ln;
-	  last_col_num = cn;
-	  s = _("(continued):");
-	}
-      else
-	{
-	  cnt = cn - last_col_num;
-	  fprintf (stderr,
-		   "%s%c", &spaces[cnt > MAX_SPACES
-				   ? 0 : MAX_SPACES - cnt + 4],
-		   pointer);
-	  last_col_num = cn;
-	}
-    }
-  if (ffebad_places_ == 0)
-    {
-      /* Didn't output "warning:" string, capitalize it for message.  */
-      if (s[0] != '\0')
-	{
-	  char c;
-
-	  c = TOUPPER (s[0]);
-	  fprintf (stderr, "%c%s ", c, &s[1]);
-	}
-      else if (s[0] != '\0')
-	fprintf (stderr, "%s ", s);
-    }
-  else
-    fputc ('\n', stderr);
-
-  /* Release the ffewhere info. */
-
-  for (bi = 0; bi < FFEBAD_MAX_; ++bi)
-    {
-      ffewhere_line_kill (ffebad_here_[bi].line);
-      ffewhere_column_kill (ffebad_here_[bi].col);
-    }
-
-  /* Now display the message. */
-
-  bufi = 0;
-  for (i = 0; (c = ffebad_message_[i]) != '\0'; ++i)
-    {
-      if (c == '%')
-	{
-	  c = ffebad_message_[++i];
-	  if (ISUPPER (c))
-	    {
-	      index = c - 'A';
-
-	      if ((index < 0) || (index >= FFEBAD_MAX_))
-		{
-		  bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
-		  bufi = ffebad_bufputc_ (buf, bufi, c);
-		}
-	      else
-		{
-		  s = ffebad_string_[index];
-		  if (s == NULL)
-		    bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
-		  else
-		    bufi = ffebad_bufputs_ (buf, bufi, s);
-		}
-	    }
-	  else if (ISDIGIT (c))
-	    {
-	      index = c - '0';
-
-	      if ((index < 0) || (index >= FFEBAD_MAX_))
-		{
-		  bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!] %"));
-		  bufi = ffebad_bufputc_ (buf, bufi, c);
-		}
-	      else
-		{
-		  pointer = ffebad_here_[index].tag + '1';
-		  if (pointer == FFEBAD_MAX_ + '1')
-		    pointer = '?';
-		  else if (ffebad_places_ == 1)
-		    pointer = '^';
-		  bufi = ffebad_bufputc_ (buf, bufi, '(');
-		  bufi = ffebad_bufputc_ (buf, bufi, pointer);
-		  bufi = ffebad_bufputc_ (buf, bufi, ')');
-		}
-	    }
-	  else if (c == '\0')
-	    break;
-	  else if (c == '%')
-	    bufi = ffebad_bufputc_ (buf, bufi, '%');
-	  else
-	    {
-	      bufi = ffebad_bufputs_ (buf, bufi, _("[REPORT BUG!!]"));
-	      bufi = ffebad_bufputc_ (buf, bufi, '%');
-	      bufi = ffebad_bufputc_ (buf, bufi, c);
-	    }
-	}
-      else
-	bufi = ffebad_bufputc_ (buf, bufi, c);
-    }
-  bufi = ffebad_bufputc_ (buf, bufi, '\n');
-  bufi = ffebad_bufflush_ (buf, bufi);
-}
diff --git a/gcc/f/bad.def b/gcc/f/bad.def
deleted file mode 100644
index 92d7e23..0000000
--- a/gcc/f/bad.def
+++ /dev/null
@@ -1,1103 +0,0 @@
-/* bad.def -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 1997, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      bad.c
-
-   Modifications:
-*/
-
-#define INFORM FFEBAD_severityINFORMATIONAL
-#define TRIVIAL FFEBAD_severityTRIVIAL
-#define WARN FFEBAD_severityWARNING
-#define PECULIAR FFEBAD_severityPECULIAR
-#define FATAL FFEBAD_severityFATAL
-#define WEIRD FFEBAD_severityWEIRD
-#define SEVERE FFEBAD_severitySEVERE
-#define DISASTER FFEBAD_severityDISASTER
-
-FFEBAD_MSG (FFEBAD_MISSING_FIRST_BINARY_OPERAND, FATAL,
-/* xgettext:no-c-format */
-"Missing first operand for binary operator at %0")
-FFEBAD_MSG (FFEBAD_NULL_CHAR_CONST, WARN,
-/* xgettext:no-c-format */
-"Zero-length character constant at %0")
-FFEBAD_MSG (FFEBAD_INVALID_TOKEN_IN_EXPRESSION, FATAL,
-/* xgettext:no-c-format */
-"Invalid token at %0 in expression or subexpression at %1")
-FFEBAD_MSG (FFEBAD_MISSING_OPERAND_FOR_OPERATOR, FATAL,
-/* xgettext:no-c-format */
-"Missing operand for operator at %1 at end of expression at %0")
-FFEBAD_MSG (FFEBAD_LABEL_ALREADY_DEFINED, FATAL,
-/* xgettext:no-c-format */
-"Label %A already defined at %1 when redefined at %0")
-FFEBAD_MSG (FFEBAD_UNRECOGNIZED_CHARACTER, FATAL,
-/* xgettext:no-c-format */
-"Unrecognized character at %0 [info -f g77 M LEX]")
-FFEBAD_MSG (FFEBAD_LABEL_WITHOUT_STMT, WARN,
-/* xgettext:no-c-format */
-"Label definition %A at %0 on empty statement (as of %1)")
-FFEBAD_MSG (FFEBAD_EXTRA_LABEL_DEF, FATAL,
-/* xgettext:no-c-format */
-LONG("Extra label definition %A at %0 -- perhaps previous label definition %B at %1 should have CONTINUE statement?")
-/* xgettext:no-c-format */
-SHORT("Extra label definition %A at %0 following label definition %B at %1"))
-FFEBAD_MSG (FFEBAD_FIRST_CHAR_INVALID, FATAL,
-/* xgettext:no-c-format */
-"Invalid first character at %0 [info -f g77 M LEX]")
-FFEBAD_MSG (FFEBAD_LINE_TOO_LONG, FATAL,
-/* xgettext:no-c-format */
-"Line too long as of %0 [info -f g77 M LEX]")
-FFEBAD_MSG (FFEBAD_LABEL_FIELD_NOT_NUMERIC, FATAL,
-/* xgettext:no-c-format */
-"Non-numeric character at %0 in label field [info -f g77 M LEX]")
-FFEBAD_MSG (FFEBAD_LABEL_NUMBER_INVALID, FATAL,
-/* xgettext:no-c-format */
-"Label number at %0 not in range 1-99999")
-FFEBAD_MSG (FFEBAD_NON_ANSI_COMMENT, WARN,
-/* xgettext:no-c-format */
-"At %0, '!' and '/*' are not valid comment delimiters")
-FFEBAD_MSG (FFEBAD_NON_ANSI_CONTINUATION_COLUMN, WARN,
-/* xgettext:no-c-format */
-"Continuation indicator at %0 must appear in column 6 [info -f g77 M LEX]")
-FFEBAD_MSG (FFEBAD_LABEL_ON_CONTINUATION, FATAL,
-/* xgettext:no-c-format */
-"Label at %0 invalid with continuation line indicator at %1 [info -f g77 M LEX]")
-FFEBAD_MSG (FFEBAD_INVALID_CONTINUATION, FATAL,
-/* xgettext:no-c-format */
-LONG("Continuation indicator at %0 invalid on first non-comment line of file or following END or INCLUDE [info -f g77 M LEX]")
-/* xgettext:no-c-format */
-SHORT("Continuation indicator at %0 invalid here [info -f g77 M LEX]"))
-FFEBAD_MSG (FFEBAD_NO_CLOSING_APOSTROPHE, FATAL,
-/* xgettext:no-c-format */
-"Character constant at %0 has no closing apostrophe at %1")
-FFEBAD_MSG (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS, FATAL,
-/* xgettext:no-c-format */
-"Hollerith constant at %0 specified %A more characters than are present as of %1")
-FFEBAD_MSG (FFEBAD_MISSING_CLOSE_PAREN, FATAL,
-/* xgettext:no-c-format */
-"Missing close parenthese at %0 needed to match open parenthese at %1")
-FFEBAD_MSG (FFEBAD_INTEGER_TOO_LARGE, FATAL,
-/* xgettext:no-c-format */
-"Integer at %0 too large")
-FFEBAD_MSG (FFEBAD_BAD_MAGICAL, WARN,
-/* xgettext:no-c-format */
-LONG("Integer at %0 too large except as negative number (preceded by unary minus sign)")
-/* xgettext:no-c-format */
-SHORT("Non-negative integer at %0 too large"))
-FFEBAD_MSG (FFEBAD_BAD_MAGICAL_PRECEDENCE, WARN,
-/* xgettext:no-c-format */
-LONG("Integer at %0 too large; even though preceded by unary minus sign at %1, subsequent operator at %2 has precedence over unary minus -- enclose unary minus sign and integer in parentheses to force precedence")
-/* xgettext:no-c-format */
-SHORT("Integer at %0 too large (%2 has precedence over %1)"))
-FFEBAD_MSG (FFEBAD_BAD_MAGICAL_BINARY, WARN,
-/* xgettext:no-c-format */
-LONG("Integer at %0 too large; even though preceded by minus sign at %1, because minus sign is a binary, not unary, operator -- insert plus sign before minus sign to change it to a unary minus sign")
-/* xgettext:no-c-format */
-SHORT("Integer at %0 too large (needs unary, not binary, minus at %1)"))
-FFEBAD_MSG (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY, WARN,
-/* xgettext:no-c-format */
-LONG("Integer at %0 too large; even though preceded by minus sign at %1, subsequent operator at %2 has precedence over minus, and that minus sign should be a unary minus rather than a binary minus -- insert plus sign before minus sign to change it to a unary minus sign, and enclose unary minus sign and integer in parentheses to force precedence")
-/* xgettext:no-c-format */
-SHORT("Integer at %0 too large (%2 has precedence over %1, which needs to be unary, not binary, minus)"))
-FFEBAD_MSG (FFEBAD_IGNORING_PERIOD, FATAL,
-/* xgettext:no-c-format */
-"Period at %0 not followed by digits for floating-point number or by `NOT.', `TRUE.', or `FALSE.'")
-FFEBAD_MSG (FFEBAD_INSERTING_PERIOD, FATAL,
-/* xgettext:no-c-format */
-"Missing close-period between `.%A' at %0 and %1")
-FFEBAD_MSG (FFEBAD_INVALID_EXPONENT, FATAL,
-/* xgettext:no-c-format */
-"Invalid exponent at %0 for real constant at %1; nondigit `%A' in exponent field")
-FFEBAD_MSG (FFEBAD_MISSING_EXPONENT_VALUE, FATAL,
-/* xgettext:no-c-format */
-"Missing value at %1 for real-number exponent at %0")
-FFEBAD_MSG (FFEBAD_MISSING_BINARY_OPERATOR, FATAL,
-/* xgettext:no-c-format */
-"Expected binary operator between expressions at %0 and at %1")
-FFEBAD_MSG (FFEBAD_INVALID_DOTDOT, FATAL,
-/* xgettext:no-c-format */
-LONG("Period at %0 not followed by valid keyword forming a valid binary operator; `.%A.' is not a valid binary operator")
-/* xgettext:no-c-format */
-SHORT("`.%A.' at %0 not a binary operator"))
-FFEBAD_MSG (FFEBAD_QUOTE_MISSES_DIGITS, FATAL,
-/* xgettext:no-c-format */
-LONG("Double-quote at %0 not followed by a string of valid octal digits at %1")
-/* xgettext:no-c-format */
-SHORT("Invalid octal constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_BINARY_DIGIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid binary digit(s) found in string of digits at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid binary constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_HEX_DIGIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid hexadecimal digit(s) found in string of digits at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid hexadecimal constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_OCTAL_DIGIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid octal digit(s) found in string of digits at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid octal constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_RADIX_SPECIFIER, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid radix specifier `%A' at %0 for typeless constant at %1")
-/* xgettext:no-c-format */
-SHORT("Invalid typeless constant at %1"))
-FFEBAD_MSG (FFEBAD_INVALID_TYPELESS_BINARY_DIGIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid binary digit(s) found in string of digits at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid binary constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_TYPELESS_OCTAL_DIGIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid octal digit(s) found in string of digits at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid octal constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_TYPELESS_HEX_DIGIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid hexadecimal digit(s) found in string of digits at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid hexadecimal constant at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_COMPLEX_PART, FATAL,
-/* xgettext:no-c-format */
-LONG("%A part of complex constant at %0 must be a real or integer constant -- otherwise use CMPLX() or COMPLEX() in place of ()")
-/* xgettext:no-c-format */
-SHORT("%A part of complex constant at %0 not a real or integer constant"))
-FFEBAD_MSG (FFEBAD_INVALID_PERCENT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid keyword `%%%A' at %0 in this context")
-/* xgettext:no-c-format */
-SHORT("Invalid keyword `%%%A' at %0"))
-FFEBAD_MSG (FFEBAD_NULL_EXPRESSION, FATAL,
-/* xgettext:no-c-format */
-LONG("Null expression between %0 and %1 invalid in this context")
-/* xgettext:no-c-format */
-SHORT("Invalid null expression between %0 and %1"))
-FFEBAD_MSG (FFEBAD_CONCAT_ARGS_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Concatenation operator at %0 must operate on two subexpressions of character type, but neither subexpression at %1 or %2 is of character type")
-/* xgettext:no-c-format */
-SHORT("Invalid operands at %1 and %2 for concatenation operator at %0"))
-FFEBAD_MSG (FFEBAD_CONCAT_ARG_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Concatenation operator at %0 must operate on two subexpressions of character type, but the subexpression at %1 is not of character type")
-/* xgettext:no-c-format */
-SHORT("Invalid operand at %1 for concatenation operator at %0"))
-FFEBAD_MSG (FFEBAD_CONCAT_ARG_KIND, FATAL,
-/* xgettext:no-c-format */
-LONG("Concatenation operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning character scalars, or a combination of both -- but the subexpression at %1 is %A")
-/* xgettext:no-c-format */
-SHORT("Invalid operand (is %A) at %1 for concatenation operator at %0"))
-FFEBAD_MSG (FFEBAD_MATH_ARGS_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but neither subexpression at %1 or %2 is of arithmetic type")
-/* xgettext:no-c-format */
-SHORT("Invalid operands at %1 and %2 for arithmetic operator at %0"))
-FFEBAD_MSG (FFEBAD_MATH_ARG_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Arithmetic operator at %0 must operate on two subexpressions of arithmetic type, but the subexpression at %1 is not of arithmetic type")
-/* xgettext:no-c-format */
-SHORT("Invalid operand at %1 for arithmetic operator at %0"))
-FFEBAD_MSG (FFEBAD_MATH_ARG_KIND, FATAL,
-/* xgettext:no-c-format */
-LONG("Arithmetic operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning arithmetic scalars, or a combination of both -- but the subexpression at %1 is %A")
-/* xgettext:no-c-format */
-SHORT("Invalid operand (is %A) at %1 for arithmetic operator at %0"))
-FFEBAD_MSG (FFEBAD_NO_CLOSING_QUOTE, FATAL,
-/* xgettext:no-c-format */
-LONG("Character constant at %0 has no closing quote at %1 [info -f g77 M LEX]")
-/* xgettext:no-c-format */
-SHORT("Unterminated character constant at %0 [info -f g77 M LEX]"))
-FFEBAD_MSG (FFEBAD_BAD_CHAR_CONTINUE, FATAL,
-/* xgettext:no-c-format */
-LONG("Continuation line at %0 must have initial `&' since it continues a character context [info -f g77 M LEX]")
-/* xgettext:no-c-format */
-SHORT("Missing initial `&' on continuation line at %0 [info -f g77 M LEX]"))
-FFEBAD_MSG (FFEBAD_BAD_LEXTOK_CONTINUE, FATAL,
-/* xgettext:no-c-format */
-LONG("Continuation line at %0 must have initial `&' since it continues a split lexical token [info -f g77 M LEX]")
-/* xgettext:no-c-format */
-SHORT("Missing initial `&' on continuation line at %0 [info -f g77 M LEX]"))
-FFEBAD_MSG (FFEBAD_BAD_FREE_CONTINUE, FATAL,
-/* xgettext:no-c-format */
-LONG("Continuation line at %0 invalid because it consists only of a single `&' as the only nonblank character")
-/* xgettext:no-c-format */
-SHORT("Invalid continuation line at %0"))
-FFEBAD_MSG (FFEBAD_STMT_BEGINS_BAD, FATAL,
-/* xgettext:no-c-format */
-LONG("Statement at %0 begins with invalid token [info -f g77 M LEX]")
-/* xgettext:no-c-format */
-SHORT("Invalid statement at %0 [info -f g77 M LEX]"))
-FFEBAD_MSG (FFEBAD_SEMICOLON, FATAL,
-/* xgettext:no-c-format */
-"Semicolon at %0 is an invalid token")
-FFEBAD_MSG (FFEBAD_UNREC_STMT, FATAL,
-/* xgettext:no-c-format */
-LONG("Unrecognized statement name at %0 and invalid form for assignment or statement-function definition at %1")
-/* xgettext:no-c-format */
-SHORT("Invalid statement at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_STMT_FORM, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid form for %A statement at %0")
-/* xgettext:no-c-format */
-SHORT("Invalid %A statement at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_HOLL_IN_STMT, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid use of hollerith constant in statement at %0 -- enclose the constant in parentheses (for example, change BACKSPACE 2HAB to BACKSPACE (2HAB))")
-/* xgettext:no-c-format */
-SHORT("Enclose hollerith constant in statement at %0 in parentheses"))
-FFEBAD_MSG (FFEBAD_FORMAT_EXTRA_COMMA, FATAL,
-/* xgettext:no-c-format */
-"Extraneous comma in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_MISSING_COMMA, WARN,
-/* xgettext:no-c-format */
-"Missing comma in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_SPURIOUS_SIGN, FATAL,
-/* xgettext:no-c-format */
-"Spurious sign in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_SPURIOUS_NUMBER, FATAL,
-/* xgettext:no-c-format */
-"Spurious number in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_TEXT_IN_NUMBER, FATAL,
-/* xgettext:no-c-format */
-"Spurious text trailing number in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_P_NOCOMMA, FATAL,
-/* xgettext:no-c-format */
-LONG("nP control edit descriptor not followed by comma but followed by edit descriptor at %0 other than D, E, EN, F, or G")
-/* xgettext:no-c-format */
-SHORT("Invalid edit descriptor at %0 following nP control edit descriptor"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_SPEC, FATAL,
-/* xgettext:no-c-format */
-"Unrecognized FORMAT specifier at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_I_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid I specifier in FORMAT statement at %0 -- correct form: [r]Iw.[m]")
-/* xgettext:no-c-format */
-SHORT("Invalid I specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_B_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid B specifier in FORMAT statement at %0 -- correct form: [r]Bw.[m]")
-/* xgettext:no-c-format */
-SHORT("Invalid B specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_O_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid O specifier in FORMAT statement at %0 -- correct form: [r]Ow.[m]")
-/* xgettext:no-c-format */
-SHORT("Invalid O specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_Z_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid Z specifier in FORMAT statement at %0 -- correct form: [r]Zw.[m]")
-/* xgettext:no-c-format */
-SHORT("Invalid Z specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_F_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid F specifier in FORMAT statement at %0 -- correct form: [r]Fw.d")
-/* xgettext:no-c-format */
-SHORT("Invalid F specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_E_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid E specifier in FORMAT statement at %0 -- correct form: [r]Ew.d[Ee]")
-/* xgettext:no-c-format */
-SHORT("Invalid E specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_EN_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid EN specifier in FORMAT statement at %0 -- correct form: [r]ENw.d[Ee]")
-/* xgettext:no-c-format */
-SHORT("Invalid EN specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_G_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid G specifier in FORMAT statement at %0 -- correct form: [r]Gw.d[Ee]")
-/* xgettext:no-c-format */
-SHORT("Invalid G specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_L_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid L specifier in FORMAT statement at %0 -- correct form: [r]Lw")
-/* xgettext:no-c-format */
-SHORT("Invalid L specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_A_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid A specifier in FORMAT statement at %0 -- correct form: [r]A[w]")
-/* xgettext:no-c-format */
-SHORT("Invalid A specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_D_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid D specifier in FORMAT statement at %0 -- correct form: [r]Dw.d")
-/* xgettext:no-c-format */
-SHORT("Invalid D specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_Q_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid Q specifier in FORMAT statement at %0 -- correct form: Q")
-/* xgettext:no-c-format */
-SHORT("Invalid Q specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_DOLLAR_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid $ specifier in FORMAT statement at %0 -- correct form: $")
-/* xgettext:no-c-format */
-SHORT("Invalid $ specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_P_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid P specifier in FORMAT statement at %0 -- correct form: kP")
-/* xgettext:no-c-format */
-SHORT("Invalid P specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_T_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid T specifier in FORMAT statement at %0 -- correct form: Tn")
-/* xgettext:no-c-format */
-SHORT("Invalid T specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_TL_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid TL specifier in FORMAT statement at %0 -- correct form: TLn")
-/* xgettext:no-c-format */
-SHORT("Invalid TL specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_TR_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid TR specifier in FORMAT statement at %0 -- correct form: TRn")
-/* xgettext:no-c-format */
-SHORT("Invalid TR specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_X_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid X specifier in FORMAT statement at %0 -- correct form: nX")
-/* xgettext:no-c-format */
-SHORT("Invalid X specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_S_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid S specifier in FORMAT statement at %0 -- correct form: S")
-/* xgettext:no-c-format */
-SHORT("Invalid S specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_SP_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid SP specifier in FORMAT statement at %0 -- correct form: SP")
-/* xgettext:no-c-format */
-SHORT("Invalid SP specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_SS_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid SS specifier in FORMAT statement at %0 -- correct form: SS")
-/* xgettext:no-c-format */
-SHORT("Invalid SS specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_BN_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid BN specifier in FORMAT statement at %0 -- correct form: BN")
-/* xgettext:no-c-format */
-SHORT("Invalid BN specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_BZ_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid BZ specifier in FORMAT statement at %0 -- correct form: BZ")
-/* xgettext:no-c-format */
-SHORT("Invalid BZ specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_COLON_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid : specifier in FORMAT statement at %0 -- correct form: :")
-/* xgettext:no-c-format */
-SHORT("Invalid : specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_BAD_H_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid H specifier in FORMAT statement at %0 -- correct form: nHcharacters  !where n is an unsigned decimal constant, and characters               !contains exactly n characters (including spaces)")
-/* xgettext:no-c-format */
-SHORT("Invalid H specifier in FORMAT statement at %0"))
-FFEBAD_MSG (FFEBAD_FORMAT_MISSING_PAREN, FATAL,
-/* xgettext:no-c-format */
-"Missing close-parenthese(s) in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_MISSING_DOT, FATAL,
-/* xgettext:no-c-format */
-"Missing number following period in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_MISSING_EXP, FATAL,
-/* xgettext:no-c-format */
-"Missing number following `E' in FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_EXPR_TOKEN, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid token with FORMAT run-time expression at %0 -- use the traditional operators .LT., .LE., .GT., .GE., .EQ., and .NE. in place of the newer tokens <, <=, >, >=, ==, and !=, because > ends an expression within a FORMAT statement")
-/* xgettext:no-c-format */
-SHORT("Invalid token with FORMAT run-time expression at %0"))
-FFEBAD_MSG (FFEBAD_TRAILING_COMMA, WARN,
-/* xgettext:no-c-format */
-"Spurious trailing comma preceding terminator at %0")
-FFEBAD_MSG (FFEBAD_INTERFACE_ASSIGNMENT, WARN,
-/* xgettext:no-c-format */
-"At %0, specify OPERATOR instead of ASSIGNMENT for INTERFACE statement not specifying the assignment operator (=)")
-FFEBAD_MSG (FFEBAD_INTERFACE_OPERATOR, WARN,
-/* xgettext:no-c-format */
-"At %0, specify ASSIGNMENT instead of OPERATOR for INTERFACE statement specifying the assignment operator (=)")
-FFEBAD_MSG (FFEBAD_INTERFACE_NONLETTER, FATAL,
-/* xgettext:no-c-format */
-LONG("Defined operator at %0 contains a nonletter -- must contain only letters A-Z (or a-z)")
-/* xgettext:no-c-format */
-SHORT("Nonletter in defined operator at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_TYPEDECL_ATTR, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid type-declaration attribute at %0 -- must be one of: DIMENSION(array-spec), EXTERNAL, INTRINSIC, PARAMETER, or SAVE")
-/* xgettext:no-c-format */
-SHORT("Invalid type-declaration attribute at %0"))
-FFEBAD_MSG (FFEBAD_INVALID_TYPEDECL_INIT, FATAL,
-/* xgettext:no-c-format */
-"Cannot specify =initialization-expr at %0 unless `::' appears before list of objects")
-FFEBAD_MSG (FFEBAD_LABEL_USE_DEF, FATAL,
-/* xgettext:no-c-format */
-"Reference to label at %1 inconsistent with its definition at %0")
-FFEBAD_MSG (FFEBAD_LABEL_USE_USE, FATAL,
-/* xgettext:no-c-format */
-"Reference to label at %1 inconsistent with earlier reference at %0")
-FFEBAD_MSG (FFEBAD_LABEL_DEF_DO, FATAL,
-/* xgettext:no-c-format */
-"DO-statement reference to label at %1 follows its definition at %0")
-FFEBAD_MSG (FFEBAD_LABEL_BLOCK, WARN,
-/* xgettext:no-c-format */
-"Reference to label at %1 is outside block containing definition at %0")
-FFEBAD_MSG (FFEBAD_LABEL_DO_BLOCK_DO, FATAL,
-/* xgettext:no-c-format */
-"DO-statement references to label at %0 and %2 separated by unterminated block starting at %1")
-FFEBAD_MSG (FFEBAD_LABEL_DO_BLOCK_END, FATAL,
-/* xgettext:no-c-format */
-"DO-statement reference to label at %0 and label definition at %2 separated by unterminated block starting at %1")
-FFEBAD_MSG (FFEBAD_INVALID_LABEL_DEF, FATAL,
-/* xgettext:no-c-format */
-"Label definition at %0 invalid on this kind of statement")
-FFEBAD_MSG (FFEBAD_ORDER_1, FATAL,
-/* xgettext:no-c-format */
-"Statement at %0 invalid in this context")
-FFEBAD_MSG (FFEBAD_ORDER_2, FATAL,
-/* xgettext:no-c-format */
-"Statement at %0 invalid in context established by statement at %1")
-FFEBAD_MSG (FFEBAD_CONSTRUCT_NAMED, FATAL,
-/* xgettext:no-c-format */
-"Statement at %0 must specify construct name specified at %1")
-FFEBAD_MSG (FFEBAD_CONSTRUCT_NOT_NAMED, FATAL,
-/* xgettext:no-c-format */
-"Construct name at %0 superfluous, no construct name specified at %1")
-FFEBAD_MSG (FFEBAD_CONSTRUCT_WRONG_NAME, FATAL,
-/* xgettext:no-c-format */
-"Construct name at %0 not the same as construct name at %1")
-FFEBAD_MSG (FFEBAD_CONSTRUCT_NO_DO_NAME, FATAL,
-/* xgettext:no-c-format */
-"Construct name at %0 does not match construct name for any containing DO constructs")
-FFEBAD_MSG (FFEBAD_DO_HAD_LABEL, FATAL,
-/* xgettext:no-c-format */
-"Label definition missing at %0 for DO construct specifying label at %1")
-FFEBAD_MSG (FFEBAD_AFTER_ELSE, FATAL,
-/* xgettext:no-c-format */
-"Statement at %0 follows ELSE block for IF construct at %1")
-FFEBAD_MSG (FFEBAD_FORMAT_NO_LABEL_DEF, FATAL,
-/* xgettext:no-c-format */
-"No label definition for FORMAT statement at %0")
-FFEBAD_MSG (FFEBAD_SECOND_ELSE_WHERE, FATAL,
-/* xgettext:no-c-format */
-"Second occurrence of ELSE WHERE at %0 within WHERE at %1")
-FFEBAD_MSG (FFEBAD_END_WO, WARN,
-/* xgettext:no-c-format */
-"END statement at %0 missing `%A' keyword required for internal or module procedure(s) bounded by %1")
-FFEBAD_MSG (FFEBAD_INVALID_MODULE_PROCEDURE, FATAL,
-/* xgettext:no-c-format */
-"MODULE PROCEDURE statement at %0 disallowed because INTERFACE at %1 specifies no generic name, operator, or assignment")
-FFEBAD_MSG (FFEBAD_BLOCKDATA_NOT_NAMED, FATAL,
-/* xgettext:no-c-format */
-"BLOCK DATA name at %0 superfluous, no name specified at %1")
-FFEBAD_MSG (FFEBAD_PROGRAM_NOT_NAMED, FATAL,
-/* xgettext:no-c-format */
-"Program name at %0 superfluous, no PROGRAM statement specified at %1")
-FFEBAD_MSG (FFEBAD_UNIT_WRONG_NAME, FATAL,
-/* xgettext:no-c-format */
-"Program unit name at %0 not the same as name at %1")
-FFEBAD_MSG (FFEBAD_TYPE_WRONG_NAME, FATAL,
-/* xgettext:no-c-format */
-"Type name at %0 not the same as name at %1")
-FFEBAD_MSG (FFEBAD_EOF_BEFORE_BLOCK_END, FATAL,
-/* xgettext:no-c-format */
-"End of source file before end of block started at %0")
-FFEBAD_MSG (FFEBAD_UNDEF_LABEL, FATAL,
-/* xgettext:no-c-format */
-"Undefined label, first referenced at %0")
-FFEBAD_MSG (FFEBAD_CONFLICTING_SAVES, WARN,
-/* xgettext:no-c-format */
-"SAVE statement or attribute at %1 cannot be specified along with SAVE statement or attribute at %0")
-FFEBAD_MSG (FFEBAD_CONFLICTING_ACCESSES, FATAL,
-/* xgettext:no-c-format */
-"PUBLIC or PRIVATE statement at %1 cannot be specified along with PUBLIC or PRIVATE statement at %0")
-FFEBAD_MSG (FFEBAD_RETURN_IN_MAIN, WARN,
-/* xgettext:no-c-format */
-"RETURN statement at %0 invalid within a main program unit")
-FFEBAD_MSG (FFEBAD_ALTRETURN_IN_PROGRAM, FATAL,
-/* xgettext:no-c-format */
-"Alternate return specifier at %0 invalid within a main program unit")
-FFEBAD_MSG (FFEBAD_ALTRETURN_IN_FUNCTION, FATAL,
-/* xgettext:no-c-format */
-"Alternate return specifier at %0 invalid within a function")
-FFEBAD_MSG (FFEBAD_DERIVTYP_ACCESS, FATAL,
-/* xgettext:no-c-format */
-"Access specifier or PRIVATE statement at %0 invalid for derived-type definition within other than the specification part of a module")
-FFEBAD_MSG (FFEBAD_DERIVTYP_ACCESS_FIRST, FATAL,
-/* xgettext:no-c-format */
-"Access specifier at %0 must immediately follow derived-type statement at %1 with no intervening statements")
-FFEBAD_MSG (FFEBAD_DERIVTYP_NO_COMPONENTS, FATAL,
-/* xgettext:no-c-format */
-"No components specified as of %0 for derived-type definition beginning at %1")
-FFEBAD_MSG (FFEBAD_STRUCT_NO_COMPONENTS, FATAL,
-/* xgettext:no-c-format */
-"No components specified as of %0 for structure definition beginning at %1")
-FFEBAD_MSG (FFEBAD_STRUCT_MISSING_NAME, FATAL,
-/* xgettext:no-c-format */
-"Missing structure name for outer structure definition at %0")
-FFEBAD_MSG (FFEBAD_STRUCT_IGNORING_FIELD, FATAL,
-/* xgettext:no-c-format */
-"Field names at %0 for outer structure definition -- specify them in a subsequent RECORD statement instead")
-FFEBAD_MSG (FFEBAD_STRUCT_MISSING_FIELD, FATAL,
-/* xgettext:no-c-format */
-"Missing field name(s) for structure definition at %0 within structure definition at %1")
-FFEBAD_MSG (FFEBAD_MAP_NO_COMPONENTS, FATAL,
-/* xgettext:no-c-format */
-"No components specified as of %0 for map beginning at %1")
-FFEBAD_MSG (FFEBAD_UNION_NO_TWO_MAPS, FATAL,
-/* xgettext:no-c-format */
-"Zero or one maps specified as of %0 for union beginning at %1 -- at least two are required")
-FFEBAD_MSG (FFEBAD_MISSING_SPECIFIER, FATAL,
-/* xgettext:no-c-format */
-"Missing %A specifier in statement at %0")
-FFEBAD_MSG (FFEBAD_NAMELIST_ITEMS, FATAL,
-/* xgettext:no-c-format */
-"Items in I/O list starting at %0 invalid for namelist-directed I/O")
-FFEBAD_MSG (FFEBAD_CONFLICTING_SPECS, FATAL,
-/* xgettext:no-c-format */
-"Conflicting I/O control specifications at %0 and %1")
-FFEBAD_MSG (FFEBAD_NO_UNIT_SPEC, FATAL,
-/* xgettext:no-c-format */
-"No UNIT= specifier in I/O control list at %0")
-FFEBAD_MSG (FFEBAD_MISSING_ADVANCE_SPEC, FATAL,
-/* xgettext:no-c-format */
-"Specification at %0 requires ADVANCE=`NO' specification in same I/O control list")
-FFEBAD_MSG (FFEBAD_MISSING_FORMAT_SPEC, FATAL,
-/* xgettext:no-c-format */
-"Specification at %0 requires explicit FMT= specification in same I/O control list")
-FFEBAD_MSG (FFEBAD_SPEC_VALUE, FATAL,
-/* xgettext:no-c-format */
-LONG("Unrecognized value for character constant at %0 -- expecting %A")
-/* xgettext:no-c-format */
-SHORT("Unrecognized value for character constant at %0"))
-FFEBAD_MSG (FFEBAD_CASE_SECOND_DEFAULT, FATAL,
-/* xgettext:no-c-format */
-"Second occurrence of CASE DEFAULT at %0 within SELECT CASE at %1")
-FFEBAD_MSG (FFEBAD_CASE_DUPLICATE, FATAL,
-/* xgettext:no-c-format */
-"Duplicate or overlapping case values/ranges at %0 and %1")
-FFEBAD_MSG (FFEBAD_CASE_TYPE_DISAGREE, FATAL,
-/* xgettext:no-c-format */
-"Type and/or kind-type parameter disagreement between CASE value or value within range at %0 and SELECT CASE at %1")
-FFEBAD_MSG (FFEBAD_CASE_LOGICAL_RANGE, FATAL,
-/* xgettext:no-c-format */
-"Range specification at %0 invalid for CASE statement within logical-type SELECT CASE statement")
-FFEBAD_MSG (FFEBAD_CASE_BAD_RANGE, FATAL,
-/* xgettext:no-c-format */
-LONG("Range specification at %0 invalid -- at least one expression must be specified, or use CASE DEFAULT")
-/* xgettext:no-c-format */
-SHORT("Range specification at %0 invalid"))
-FFEBAD_MSG (FFEBAD_CASE_RANGE_USELESS, INFORM,
-/* xgettext:no-c-format */
-LONG("Range specification at %0 useless; first expression greater than second expression in range, so range can never be matched by any selection expression")
-/* xgettext:no-c-format */
-SHORT("Useless range at %0"))
-FFEBAD_MSG (FFEBAD_F90, FATAL,
-/* xgettext:no-c-format */
-"Fortran 90 feature at %0 unsupported")
-FFEBAD_MSG (FFEBAD_KINDTYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid kind at %0 for type at %1 -- unsupported or not permitted")
-/* xgettext:no-c-format */
-SHORT("Invalid kind at %0 for type at %1"))
-FFEBAD_MSG (FFEBAD_BAD_IMPLICIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Cannot establish implicit type for initial letter `%A' at %0 -- already explicitly established or used to set implicit type of some name, or backwards order of letters in letter range")
-/* xgettext:no-c-format */
-SHORT("Cannot establish implicit type for initial letter `%A' at %0"))
-FFEBAD_MSG (FFEBAD_SYMERR, FATAL,
-/* xgettext:no-c-format */
-"Invalid declaration of or reference to symbol `%A' at %0 [initially seen at %1]")
-FFEBAD_MSG (FFEBAD_LABEL_WRONG_PLACE, FATAL,
-/* xgettext:no-c-format */
-LONG("Label definition %A (at %0) invalid -- must be in columns 1-5")
-/* xgettext:no-c-format */
-SHORT("Invalid label definition %A (at %0)"))
-FFEBAD_MSG (FFEBAD_NULL_ELEMENT, FATAL,
-/* xgettext:no-c-format */
-"Null element at %0 for array reference at %1")
-FFEBAD_MSG (FFEBAD_TOO_FEW_ELEMENTS, FATAL,
-/* xgettext:no-c-format */
-"Too few elements (%A missing) as of %0 for array reference at %1")
-FFEBAD_MSG (FFEBAD_TOO_MANY_ELEMENTS, FATAL,
-/* xgettext:no-c-format */
-"Too many elements as of %0 for array reference at %1")
-FFEBAD_MSG (FFEBAD_MISSING_COLON_IN_SUBSTR, FATAL,
-/* xgettext:no-c-format */
-"Missing colon as of %0 in substring reference for %1")
-FFEBAD_MSG (FFEBAD_BAD_SUBSTR, FATAL,
-/* xgettext:no-c-format */
-"Invalid use at %0 of substring operator on %1")
-FFEBAD_MSG (FFEBAD_RANGE_SUBSTR, WARN,
-/* xgettext:no-c-format */
-"Substring begin/end point at %0 out of defined range")
-FFEBAD_MSG (FFEBAD_RANGE_ARRAY, WARN,
-/* xgettext:no-c-format */
-"Array element value at %0 out of defined range")
-FFEBAD_MSG (FFEBAD_EXPR_WRONG, FATAL,
-/* xgettext:no-c-format */
-"Expression at %0 has incorrect data type or rank for its context")
-FFEBAD_MSG (FFEBAD_DIV_BY_ZERO, WARN,
-/* xgettext:no-c-format */
-"Division by 0 (zero) at %0 (IEEE not yet supported)")
-FFEBAD_MSG (FFEBAD_DO_STEP_ZERO, FATAL,
-/* xgettext:no-c-format */
-"%A step count known to be 0 (zero) at %0")
-FFEBAD_MSG (FFEBAD_DO_END_OVERFLOW, WARN,
-/* xgettext:no-c-format */
-"%A end value plus step count known to overflow at %0")
-FFEBAD_MSG (FFEBAD_DO_IMP_OVERFLOW, WARN,
-/* xgettext:no-c-format */
-"%A begin, end, and step-count values known to result in implementation-dependent behavior due to overflow(s) in intermediate calculations at %0")
-FFEBAD_MSG (FFEBAD_DO_NULL, WARN,
-/* xgettext:no-c-format */
-"%A begin, end, and step-count values known to result in no iterations at %0")
-FFEBAD_MSG (FFEBAD_BAD_TYPES, FATAL,
-/* xgettext:no-c-format */
-"Type disagreement between expressions at %0 and %1")
-FFEBAD_MSG (FFEBAD_FORMAT_EXPR_SPEC, FATAL,
-/* xgettext:no-c-format */
-LONG("Run-time expression at %0 in FORMAT statement that does not follow the first executable statement in the program unit -- move the statement")
-/* xgettext:no-c-format */
-SHORT("FORMAT at %0 with run-time expression must follow first executable statement"))
-FFEBAD_MSG (FFEBAD_BAD_IMPDO, FATAL,
-/* xgettext:no-c-format */
-LONG("Unexpected token at %0 in implied-DO construct at %1 -- form of implied-DO is `(item-list,do-var=start,end[,incr])'")
-/* xgettext:no-c-format */
-SHORT("Unexpected token at %0 in implied-DO construct at %1"))
-FFEBAD_MSG (FFEBAD_BAD_IMPDCL, FATAL,
-/* xgettext:no-c-format */
-"No specification for implied-DO iterator `%A' at %0")
-FFEBAD_MSG (FFEBAD_IMPDO_PAREN, WARN,
-/* xgettext:no-c-format */
-"Gratuitous parentheses surround implied-DO construct at %0")
-FFEBAD_MSG (FFEBAD_ZERO_SIZE, FATAL,
-/* xgettext:no-c-format */
-"Zero-size specification invalid at %0")
-FFEBAD_MSG (FFEBAD_ZERO_ARRAY, FATAL,
-/* xgettext:no-c-format */
-"Zero-size array at %0")
-FFEBAD_MSG (FFEBAD_BAD_COMPLEX, FATAL,
-/* xgettext:no-c-format */
-"Target machine does not support complex entity of kind specified at %0")
-FFEBAD_MSG (FFEBAD_BAD_DBLCMPLX, FATAL,
-/* xgettext:no-c-format */
-"Target machine does not support DOUBLE COMPLEX, specified at %0")
-FFEBAD_MSG (FFEBAD_BAD_POWER, WARN,
-/* xgettext:no-c-format */
-"Attempt to raise constant zero to a power at %0")
-FFEBAD_MSG (FFEBAD_BOOL_ARGS_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Boolean/logical operator at %0 must operate on two subexpressions of logical type, but neither subexpression at %1 or %2 is of logical type")
-/* xgettext:no-c-format */
-SHORT("Invalid operands at %1 and %2 for boolean operator at %0"))
-FFEBAD_MSG (FFEBAD_BOOL_ARG_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Boolean/logical operator at %0 must operate on two subexpressions of logical type, but the subexpression at %1 is not of logical type")
-/* xgettext:no-c-format */
-SHORT("Invalid operand at %1 for boolean operator at %0"))
-FFEBAD_MSG (FFEBAD_BOOL_ARG_KIND, FATAL,
-/* xgettext:no-c-format */
-LONG("Boolean/logical operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning logical scalars, or a combination of both -- but the subexpression at %1 is %A")
-/* xgettext:no-c-format */
-SHORT("Invalid operand (is %A) at %1 for boolean operator at %0"))
-FFEBAD_MSG (FFEBAD_NOT_ARG_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG(".NOT. operator at %0 must operate on subexpression of logical type, but the subexpression at %1 is not of logical type")
-/* xgettext:no-c-format */
-SHORT("Invalid operand at %1 for .NOT. operator at %0"))
-FFEBAD_MSG (FFEBAD_NOT_ARG_KIND, FATAL,
-/* xgettext:no-c-format */
-LONG(".NOT. operator at %0 must operate on scalar subexpressions -- but the subexpression at %1 is %A")
-/* xgettext:no-c-format */
-SHORT("Invalid operand (is %A) at %1 for .NOT. operator at %0"))
-FFEBAD_MSG (FFEBAD_EQOP_ARGS_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but neither subexpression at %1 or %2 is of arithmetic or character type")
-/* xgettext:no-c-format */
-SHORT("Invalid operands at %1 and %2 for equality operator at %0"))
-FFEBAD_MSG (FFEBAD_EQOP_ARG_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Equality operator at %0 must operate on two subexpressions of arithmetic or character type, but the subexpression at %1 is not of arithmetic or character type")
-/* xgettext:no-c-format */
-SHORT("Invalid operand at %1 for equality operator at %0"))
-FFEBAD_MSG (FFEBAD_EQOP_ARG_KIND, FATAL,
-/* xgettext:no-c-format */
-LONG("Equality operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning arithmetic or character scalars, or a combination of both -- but the subexpression at %1 is %A")
-/* xgettext:no-c-format */
-SHORT("Invalid operand (is %A) at %1 for equality operator at %0"))
-FFEBAD_MSG (FFEBAD_RELOP_ARGS_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Relational operator at %0 must operate on two subexpressions of integer, real, or character type, but neither subexpression at %1 or %2 is of integer, real, or character type")
-/* xgettext:no-c-format */
-SHORT("Invalid operands at %1 and %2 for relational operator at %0"))
-FFEBAD_MSG (FFEBAD_RELOP_ARG_TYPE, FATAL,
-/* xgettext:no-c-format */
-LONG("Relational operator at %0 must operate on two subexpressions of integer, real, or character type, but the subexpression at %1 is not of integer, real, or character type")
-/* xgettext:no-c-format */
-SHORT("Invalid operand at %1 for relational operator at %0"))
-FFEBAD_MSG (FFEBAD_RELOP_ARG_KIND, FATAL,
-/* xgettext:no-c-format */
-LONG("Relational operator at %0 must operate on two scalar (not array) subexpressions, two function invocations returning integer, real, or character scalars, or a combination of both -- but the subexpression at %1 is %A")
-/* xgettext:no-c-format */
-SHORT("Invalid operand (is %A) at %1 for relational operator at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_REF, FATAL,
-/* xgettext:no-c-format */
-LONG("Reference to intrinsic `%A' at %0 invalid -- one or more arguments have incorrect type")
-/* xgettext:no-c-format */
-SHORT("Invalid reference to intrinsic `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_TOOFEW, FATAL,
-/* xgettext:no-c-format */
-LONG("Too few arguments passed to intrinsic `%A' at %0")
-/* xgettext:no-c-format */
-SHORT("Too few arguments for intrinsic `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_TOOMANY, FATAL,
-/* xgettext:no-c-format */
-LONG("Too many arguments passed to intrinsic `%A' at %0")
-/* xgettext:no-c-format */
-SHORT("Too many arguments for intrinsic `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_DISABLED, FATAL,
-/* xgettext:no-c-format */
-LONG("Reference to disabled intrinsic `%A' at %0")
-/* xgettext:no-c-format */
-SHORT("Disabled intrinsic `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_IS_SUBR, FATAL,
-/* xgettext:no-c-format */
-LONG("Reference to intrinsic subroutine `%A' as if it were a function at %0")
-/* xgettext:no-c-format */
-SHORT("Function reference to intrinsic subroutine `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_IS_FUNC, FATAL,
-/* xgettext:no-c-format */
-LONG("Reference to intrinsic function `%A' as if it were a subroutine at %0")
-/* xgettext:no-c-format */
-SHORT("Subroutine reference to intrinsic function `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_UNIMPL, FATAL,
-/* xgettext:no-c-format */
-LONG("Reference to unimplemented intrinsic `%A' at %0 -- use EXTERNAL to reference user-written procedure with this name")
-/* xgettext:no-c-format */
-SHORT("Unimplemented intrinsic `%A' at %0"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_UNIMPLW, WARN,
-/* xgettext:no-c-format */
-LONG("Reference to unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)")
-/* xgettext:no-c-format */
-SHORT("Unimplemented intrinsic `%A' at %0 (assumed EXTERNAL)"))
-FFEBAD_MSG (FFEBAD_INTRINSIC_AMBIG, FATAL,
-/* xgettext:no-c-format */
-"Reference to generic intrinsic `%A' at %0 could be to form %B or %C")
-FFEBAD_MSG (FFEBAD_INTRINSIC_CMPAMBIG, FATAL,
-/* xgettext:no-c-format */
-"Ambiguous use of intrinsic `%A' at %0 [info -f g77 M CMPAMBIG]")
-FFEBAD_MSG (FFEBAD_INTRINSIC_EXPIMP, WARN,
-/* xgettext:no-c-format */
-"Intrinsic `%A' referenced %Bly at %0, %Cly at %1 [info -f g77 M EXPIMP]")
-FFEBAD_MSG (FFEBAD_INTRINSIC_GLOBAL, WARN,
-/* xgettext:no-c-format */
-"Same name `%A' used for %B at %0 and %C at %1 [info -f g77 M INTGLOB]")
-FFEBAD_MSG (FFEBAD_INTRINSIC_TYPE, WARN,
-/* xgettext:no-c-format */
-"Explicit type declaration for intrinsic `%A' disagrees with invocation at %0")
-FFEBAD_MSG (FFEBAD_OPEN_INCLUDE, FATAL,
-/* xgettext:no-c-format */
-"Unable to open INCLUDE file `%A' at %0")
-FFEBAD_MSG (FFEBAD_DOITER, FATAL,
-/* xgettext:no-c-format */
-LONG("Attempt to modify variable `%A' at %0 while it serves as DO-loop iterator at %1")
-/* xgettext:no-c-format */
-SHORT("Modification of DO-loop iterator `%A' at %0"))
-FFEBAD_MSG (FFEBAD_DOITER_IMPDO, FATAL,
-/* xgettext:no-c-format */
-LONG("Attempt to modify variable `%A' via item #%B in list at %0 while it serves as implied-DO iterator at %1")
-/* xgettext:no-c-format */
-SHORT("Modification of DO-loop iterator `%A' at %0"))
-FFEBAD_MSG (FFEBAD_TOO_MANY_DIMS, FATAL,
-/* xgettext:no-c-format */
-LONG("Array has too many dimensions, as of dimension specifier at %0")
-/* xgettext:no-c-format */
-SHORT("Too many dimensions at %0"))
-FFEBAD_MSG (FFEBAD_NULL_ARGUMENT, FATAL,
-/* xgettext:no-c-format */
-"Null argument at %0 for statement function reference at %1")
-FFEBAD_MSG (FFEBAD_NULL_ARGUMENT_W, WARN,
-/* xgettext:no-c-format */
-"Null argument at %0 for procedure invocation at %1")
-FFEBAD_MSG (FFEBAD_TOO_FEW_ARGUMENTS, FATAL,
-/* xgettext:no-c-format */
-"%A too few arguments (starting with dummy argument `%B') as of %0 for statement function reference at %1")
-FFEBAD_MSG (FFEBAD_TOO_MANY_ARGUMENTS, FATAL,
-/* xgettext:no-c-format */
-"%A too many arguments as of %0 for statement function reference at %1")
-FFEBAD_MSG (FFEBAD_ARRAY_AS_SFARG, FATAL,
-/* xgettext:no-c-format */
-"Array supplied at %1 for dummy argument `%A' in statement function reference at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-"Unsupported FORMAT specifier at %0")
-FFEBAD_MSG (FFEBAD_FORMAT_VARIABLE, FATAL,
-/* xgettext:no-c-format */
-"Variable-expression FORMAT specifier at %0 -- unsupported")
-FFEBAD_MSG (FFEBAD_OPEN_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-LONG("Unsupported OPEN control item at %0 -- ACTION=, ASSOCIATEVARIABLE=, BLOCKSIZE=, BUFFERCOUNT=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, DISPOSE=, EXTENDSIZE=, INITIALSIZE=, KEY=, MAXREC=, NOSPANBLOCKS, ORGANIZATION=, PAD=, POSITION=, READONLY=, RECORDTYPE=, SHARED=, and USEROPEN= are not supported")
-/* xgettext:no-c-format */
-SHORT("Unsupported OPEN control item at %0"))
-FFEBAD_MSG (FFEBAD_INQUIRE_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-LONG("Unsupported INQUIRE control item at %0 -- ACTION=, CARRIAGECONTROL=, DEFAULTFILE=, DELIM=, KEYED=, ORGANIZATION=, PAD=, POSITION=, READ=, READWRITE=, RECORDTYPE=, and WRITE= are not supported")
-/* xgettext:no-c-format */
-SHORT("Unsupported INQUIRE control item at %0"))
-FFEBAD_MSG (FFEBAD_READ_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-LONG("Unsupported READ control item at %0 -- ADVANCE=, EOR=, KEYEQ=, KEYGE=, KEYGT=, KEYID=, NULLS=, and SIZE= are not supported")
-/* xgettext:no-c-format */
-SHORT("Unsupported READ control item at %0"))
-FFEBAD_MSG (FFEBAD_WRITE_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-LONG("Unsupported WRITE control item at %0 -- ADVANCE= and EOR= are not supported")
-/* xgettext:no-c-format */
-SHORT("Unsupported WRITE control item at %0"))
-FFEBAD_MSG (FFEBAD_VXT_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-"Unsupported VXT statement at %0")
-FFEBAD_MSG (FFEBAD_DATA_REINIT, FATAL,
-/* xgettext:no-c-format */
-"Attempt to specify second initial value for `%A' at %0")
-FFEBAD_MSG (FFEBAD_DATA_TOOFEW, FATAL,
-/* xgettext:no-c-format */
-"Too few initial values in list of initializers for `%A' at %0")
-FFEBAD_MSG (FFEBAD_DATA_TOOMANY, FATAL,
-/* xgettext:no-c-format */
-"Too many initial values in list of initializers starting at %0")
-FFEBAD_MSG (FFEBAD_DATA_RANGE, FATAL,
-/* xgettext:no-c-format */
-"Array or substring specification for `%A' out of range in statement at %0")
-FFEBAD_MSG (FFEBAD_DATA_SUBSCRIPT, FATAL,
-/* xgettext:no-c-format */
-"Array subscript #%B out of range for initialization of `%A' in statement at %0")
-FFEBAD_MSG (FFEBAD_DATA_ZERO, FATAL,
-/* xgettext:no-c-format */
-"Implied do-loop step count of 0 (zero) for iteration variable `%A' in statement at %0")
-FFEBAD_MSG (FFEBAD_DATA_EMPTY, FATAL,
-/* xgettext:no-c-format */
-"Implied do-loop iteration count of 0 (zero) for iteration variable `%A' in statement at %0")
-FFEBAD_MSG (FFEBAD_DATA_EVAL, FATAL,
-/* xgettext:no-c-format */
-"Not an integer constant expression in implied do-loop in statement at %0")
-FFEBAD_MSG (FFEBAD_DATA_MULTIPLE, FATAL,
-/* xgettext:no-c-format */
-"Attempt to specify second initial value for element of `%A' at %0")
-FFEBAD_MSG (FFEBAD_EQUIV_COMMON, FATAL,
-/* xgettext:no-c-format */
-"Attempt to EQUIVALENCE common areas `%A' and `%B' at %0")
-FFEBAD_MSG (FFEBAD_EQUIV_ALIGN, FATAL,
-/* xgettext:no-c-format */
-"Can't place `%A' as directed by EQUIVALENCE due to alignment restrictions")
-FFEBAD_MSG (FFEBAD_EQUIV_MISMATCH, FATAL,
-/* xgettext:no-c-format */
-"Mismatched EQUIVALENCE requirements for placement of `%A' at both %C and %D bytes offset from `%B'")
-FFEBAD_MSG (FFEBAD_EQUIV_RANGE, FATAL,
-/* xgettext:no-c-format */
-"Array or substring specification for `%A' out of range in EQUIVALENCE statement")
-FFEBAD_MSG (FFEBAD_EQUIV_SUBSTR, FATAL,
-/* xgettext:no-c-format */
-"Substring of non-CHARACTER entity `%A' in EQUIVALENCE statement")
-FFEBAD_MSG (FFEBAD_EQUIV_ARRAY, FATAL,
-/* xgettext:no-c-format */
-"Array reference to scalar variable `%A' in EQUIVALENCE statement")
-FFEBAD_MSG (FFEBAD_EQUIV_SUBSCRIPT, WARN,
-/* xgettext:no-c-format */
-"Array subscript #%B out of range for EQUIVALENCE of `%A'")
-FFEBAD_MSG (FFEBAD_COMMON_PAD, WARN,
-/* xgettext:no-c-format */
-LONG("Padding of %A %D required before `%B' in common block `%C' at %0 -- consider reordering members, largest-type-size first")
-/* xgettext:no-c-format */
-SHORT("Padding of %A %D required before `%B' in common block `%C' at %0"))
-FFEBAD_MSG (FFEBAD_COMMON_NEG, FATAL,
-/* xgettext:no-c-format */
-"Attempt to extend COMMON area beyond its starting point via EQUIVALENCE of `%A'")
-FFEBAD_MSG (FFEBAD_EQUIV_FEW, FATAL,
-/* xgettext:no-c-format */
-"Too few elements in reference to array `%A' in EQUIVALENCE statement")
-FFEBAD_MSG (FFEBAD_EQUIV_MANY, FATAL,
-/* xgettext:no-c-format */
-"Too many elements in reference to array `%A' in EQUIVALENCE statement")
-FFEBAD_MSG (FFEBAD_MIXED_TYPES, WARN,
-/* xgettext:no-c-format */
-"Mixed CHARACTER and non-CHARACTER types via COMMON/EQUIVALENCE -- for example, `%A' and `%B'")
-FFEBAD_MSG (FFEBAD_IMPLICIT_ADJLEN, FATAL,
-/* xgettext:no-c-format */
-LONG("Invalid length specification at %0 for IMPLICIT statement -- must be integer constant expression")
-/* xgettext:no-c-format */
-SHORT("Invalid length specification at %0"))
-FFEBAD_MSG (FFEBAD_ENTRY_CONFLICTS, FATAL,
-/* xgettext:no-c-format */
-LONG("Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s) -- must all be identical-length CHARACTER or none be CHARACTER type")
-/* xgettext:no-c-format */
-SHORT("Type of ENTRY point at %0 to function conflicts with type(s) of previous entrypoint(s)"))
-FFEBAD_MSG (FFEBAD_RETURN_VALUE_UNSET, WARN,
-/* xgettext:no-c-format */
-"Return value `%A' for FUNCTION at %0 not referenced in subprogram")
-FFEBAD_MSG (FFEBAD_COMMON_ALREADY_INIT, FATAL,
-/* xgettext:no-c-format */
-LONG("Common block `%A' initialized at %0 already initialized at %1 -- only one program unit may specify initial values for a particular common block")
-/* xgettext:no-c-format */
-SHORT("Common block `%A' initialized at %0 already initialized at %1"))
-FFEBAD_MSG (FFEBAD_COMMON_INIT_PAD, WARN,
-/* xgettext:no-c-format */
-LONG("Initial padding for common block `%A' is %B %C at %0 -- consider reordering members, largest-type-size first")
-/* xgettext:no-c-format */
-SHORT("Initial padding for common block `%A' is %B %C at %0"))
-FFEBAD_MSG (FFEBAD_COMMON_DIFF_PAD, FATAL,
-/* xgettext:no-c-format */
-LONG("Initial padding for common block `%A' is %B %D at %0 but %C %E at %1 -- consider reordering members, largest-type-size first")
-/* xgettext:no-c-format */
-SHORT("Initial padding for common block `%A' is %B %D at %0 but %C %E at %1"))
-FFEBAD_MSG (FFEBAD_COMMON_DIFF_SAVE, WARN,
-/* xgettext:no-c-format */
-"Common block `%A' is SAVEd, explicitly or implicitly, at %0 but not SAVEd at %1")
-FFEBAD_MSG (FFEBAD_COMMON_DIFF_SIZE, WARN,
-/* xgettext:no-c-format */
-"Common block `%A' is %B %D in length at %0 but %C %E at %1")
-FFEBAD_MSG (FFEBAD_COMMON_ENLARGED, FATAL,
-/* xgettext:no-c-format */
-LONG("Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1 -- use consistent definitions or reorder program units in source file")
-/* xgettext:no-c-format */
-SHORT("Common block `%A' is initialized to %B %D long at %0 but enlarged to %C %E at %1"))
-FFEBAD_MSG (FFEBAD_COMMON_BLANK_INIT, WARN,
-/* xgettext:no-c-format */
-"Blank common initialized at %0")
-FFEBAD_MSG (FFEBAD_NEED_INTRINSIC, WARN,
-/* xgettext:no-c-format */
-"Intrinsic `%A' is passed as actual argument at %0 but not explicitly declared INTRINSIC")
-FFEBAD_MSG (FFEBAD_NEED_EXTERNAL, WARN,
-/* xgettext:no-c-format */
-"External procedure `%A' is passed as actual argument at %0 but not explicitly declared EXTERNAL")
-FFEBAD_MSG (FFEBAD_SYMBOL_UPPER_CASE, WARN,
-/* xgettext:no-c-format */
-"Character `%A' (for example) is upper-case in symbol name at %0")
-FFEBAD_MSG (FFEBAD_SYMBOL_LOWER_CASE, WARN,
-/* xgettext:no-c-format */
-"Character `%A' (for example) is lower-case in symbol name at %0")
-FFEBAD_MSG (FFEBAD_SYMBOL_NOLOWER_INITCAP, WARN,
-/* xgettext:no-c-format */
-"Character `%A' not followed at some point by lower-case character in symbol name at %0")
-FFEBAD_MSG (FFEBAD_SYMBOL_LOWER_INITCAP, WARN,
-/* xgettext:no-c-format */
-"Initial character `%A' is lower-case in symbol name at %0")
-FFEBAD_MSG (FFEBAD_DO_REAL, WARN,
-/* xgettext:no-c-format */
-LONG("DO-variable `%A' is type REAL or DOUBLE PRECISION at %0 -- unexpected behavior likely")
-/* xgettext:no-c-format */
-SHORT("DO-variable `%A' is type REAL or DOUBLE PRECISION at %0"))
-FFEBAD_MSG (FFEBAD_NAMELIST_CASE, WARN,
-/* xgettext:no-c-format */
-"NAMELIST not adequately supported by run-time library for source files with case preserved")
-FFEBAD_MSG (FFEBAD_NESTED_PERCENT, WARN,
-/* xgettext:no-c-format */
-"Nested %% construct (%%VAL, %%REF, or %%DESCR) at %0")
-FFEBAD_MSG (FFEBAD_ACTUALARG, WARN,
-/* xgettext:no-c-format */
-LONG("Invalid actual argument at %0 -- replace hollerith constants with %%REF('string') and typeless constants with INTEGER constant equivalents, or use -fugly-args or -fugly")
-/* xgettext:no-c-format */
-SHORT("Invalid actual argument at %0"))
-FFEBAD_MSG (FFEBAD_QUAD_UNSUPPORTED, FATAL,
-/* xgettext:no-c-format */
-LONG("Quadruple-precision floating-point unsupported -- treating constant at %0 as double-precision")
-/* xgettext:no-c-format */
-SHORT("Quadruple-precision floating-point unsupported"))
-FFEBAD_MSG (FFEBAD_TOO_BIG_INIT, WARN,
-/* xgettext:no-c-format */
-LONG("Initialization of large (%B-unit) aggregate area `%A' at %0 slow and takes lots of memory during g77 compile")
-/* xgettext:no-c-format */
-SHORT("This could take a while (initializing `%A' at %0)..."))
-FFEBAD_MSG (FFEBAD_BLOCKDATA_STMT, FATAL,
-/* xgettext:no-c-format */
-"Statement at %0 invalid in BLOCK DATA program unit at %1")
-FFEBAD_MSG (FFEBAD_TRUNCATING_CHARACTER, FATAL,
-/* xgettext:no-c-format */
-"Truncating characters on right side of character constant at %0")
-FFEBAD_MSG (FFEBAD_TRUNCATING_HOLLERITH, FATAL,
-/* xgettext:no-c-format */
-"Truncating characters on right side of hollerith constant at %0")
-FFEBAD_MSG (FFEBAD_TRUNCATING_NUMERIC, FATAL,
-/* xgettext:no-c-format */
-"Truncating non-zero data on left side of numeric constant at %0")
-FFEBAD_MSG (FFEBAD_TRUNCATING_TYPELESS, FATAL,
-/* xgettext:no-c-format */
-"Truncating non-zero data on left side of typeless constant at %0")
-FFEBAD_MSG (FFEBAD_TYPELESS_OVERFLOW, FATAL,
-/* xgettext:no-c-format */
-"Typeless constant at %0 too large")
-FFEBAD_MSG (FFEBAD_AMPERSAND, WARN,
-/* xgettext:no-c-format */
-"First-column ampersand continuation at %0")
-FFEBAD_MSG (FFEBAD_FILEWIDE_ALREADY_SEEN, FATAL,
-/* xgettext:no-c-format */
-"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_ALREADY_SEEN_W, WARN,
-/* xgettext:no-c-format */
-"Global name `%A' defined at %0 already defined at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_DISAGREEMENT, FATAL,
-/* xgettext:no-c-format */
-"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_DISAGREEMENT_W, WARN,
-/* xgettext:no-c-format */
-"Global name `%A' is %B at %0 but is %C at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_TYPE_MISMATCH, FATAL,
-/* xgettext:no-c-format */
-"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_TYPE_MISMATCH_W, WARN,
-/* xgettext:no-c-format */
-"Global name `%A' at %0 has different type at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_NARGS, FATAL,
-/* xgettext:no-c-format */
-"Too %B arguments passed to `%A' at %0 versus definition at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_NARGS_W, WARN,
-/* xgettext:no-c-format */
-"Too %B arguments for `%A' at %0 versus invocation at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_ARG, FATAL,
-/* xgettext:no-c-format */
-"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_FILEWIDE_ARG_W, WARN,
-/* xgettext:no-c-format */
-"Argument #%B of `%A' is %C at %0 but is %D at %1 [info -f g77 M GLOBALS]")
-FFEBAD_MSG (FFEBAD_ARRAY_LARGE, FATAL,
-/* xgettext:no-c-format */
-"Array `%A' at %0 is too large to handle")
-FFEBAD_MSG (FFEBAD_SFUNC_UNUSED, WARN,
-/* xgettext:no-c-format */
-"Statement function `%A' defined at %0 is not used")
-FFEBAD_MSG (FFEBAD_INTRINSIC_Y2KBAD, WARN,
-/* xgettext:no-c-format */
-"Intrinsic `%A', invoked at %0, known to be non-Y2K-compliant [info -f g77 M Y2KBAD]")
-FFEBAD_MSG (FFEBAD_NOCANDO, DISASTER,
-/* xgettext:no-c-format */
-"Internal compiler error -- cannot perform operation")
-
-#undef INFORM
-#undef TRIVIAL
-#undef WARN
-#undef PECULIAR
-#undef FATAL
-#undef WEIRD
-#undef SEVERE
-#undef DISASTER
diff --git a/gcc/f/bad.h b/gcc/f/bad.h
deleted file mode 100644
index bd7581e..0000000
--- a/gcc/f/bad.h
+++ /dev/null
@@ -1,106 +0,0 @@
-/* bad.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      bad.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_BAD_H
-#define GCC_F_BAD_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-#define FFEBAD_MSG(KWD,SEV,MSG) KWD,
-#include "bad.def"
-#undef FFEBAD_MSG
-    FFEBAD
-  } ffebad;
-
-typedef enum
-  {
-
-    /* Order important; must be increasing severity. */
-
-    FFEBAD_severityINFORMATIONAL,	/* User notice. */
-    FFEBAD_severityTRIVIAL,	/* Internal notice. */
-    FFEBAD_severityWARNING,	/* User warning. */
-    FFEBAD_severityPECULIAR,	/* Internal warning. */
-    FFEBAD_severityPEDANTIC,	/* Pedantic, could be warning or error. */
-    FFEBAD_severityFATAL,	/* User error. */
-    FFEBAD_severityWEIRD,	/* Internal error. */
-    FFEBAD_severitySEVERE,	/* User error, cannot continue. */
-    FFEBAD_severityDISASTER,	/* Internal error, cannot continue. */
-    FFEBAD_severity
-  } ffebadSeverity;
-
-/* Typedefs. */
-
-typedef unsigned char ffebadIndex;
-
-/* Include files needed by this one. */
-
-#include "where.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-extern bool ffebad_is_inhibited_;
-
-/* Declare functions with prototypes. */
-
-void ffebad_finish (void);
-void ffebad_here (ffebadIndex i, ffewhereLine wl, ffewhereColumn wc);
-void ffebad_init_0 (void);
-bool ffebad_is_fatal (ffebad errnum);
-ffebadSeverity ffebad_severity (ffebad errnum);
-bool ffebad_start_ (bool lex_override, ffebad errnum, ffebadSeverity sev,
-		    const char *msgid);
-void ffebad_string (const char *string);
-
-/* Define macros. */
-
-#define ffebad_inhibit() (ffebad_is_inhibited_)
-#define ffebad_init_1()
-#define ffebad_init_2()
-#define ffebad_init_3()
-#define ffebad_init_4()
-#define ffebad_set_inhibit(f) (ffebad_is_inhibited_ = (f))
-#define ffebad_start(e) ffebad_start_ (FALSE, (e), FFEBAD_severity, NULL)
-#define ffebad_start_lex(e) ffebad_start_ (TRUE, (e), FFEBAD_severity, NULL)
-#define ffebad_start_msg(msgid,s) ffebad_start_ (FALSE, FFEBAD, (s), (msgid))
-#define ffebad_start_msg_lex(msgid,s) ffebad_start_ (TRUE, FFEBAD, (s), (msgid))
-#define ffebad_terminate_0()
-#define ffebad_terminate_1()
-#define ffebad_terminate_2()
-#define ffebad_terminate_3()
-#define ffebad_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_BAD_H */
diff --git a/gcc/f/bit.c b/gcc/f/bit.c
deleted file mode 100644
index 00f064b..0000000
--- a/gcc/f/bit.c
+++ /dev/null
@@ -1,200 +0,0 @@
-/* bit.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Tracks arrays of booleans in useful ways.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "bit.h"
-#include "malloc.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffebit_count -- Count # of bits set a particular way
-
-   ffebit b;  // the ffebit object
-   ffebitCount offset;	// 0..size-1
-   bool value;	// FALSE (0), TRUE (1)
-   ffebitCount range;  // # bits to test
-   ffebitCount number;	// # bits equal to value
-   ffebit_count(b,offset,value,range,&number);
-
-   Sets <number> to # bits at <offset> through <offset + range - 1> set to
-   <value>.  If <range> is 0, <number> is set to 0.  */
-
-void
-ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
-	      ffebitCount *number)
-{
-  ffebitCount element;
-  ffebitCount bitno;
-
-  assert (offset + range <= b->size);
-
-  for (*number = 0; range != 0; --range, ++offset)
-    {
-      element = offset / CHAR_BIT;
-      bitno = offset % CHAR_BIT;
-      if (value
-	  == ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
-	++ * number;
-    }
-}
-
-/* ffebit_new -- Create a new ffebit object
-
-   ffebit b;
-   ffebit_kill(b);
-
-   Destroys an ffebit object obtained via ffebit_new.  */
-
-void
-ffebit_kill (ffebit b)
-{
-  malloc_kill_ks (b->pool, b,
-		  offsetof (struct _ffebit_, bits)
-		  + (b->size + CHAR_BIT - 1) / CHAR_BIT);
-}
-
-/* ffebit_new -- Create a new ffebit object
-
-   ffebit b;
-   mallocPool pool;
-   ffebitCount size;
-   b = ffebit_new(pool,size);
-
-   Allocates an ffebit object that holds the values of <size> bits in pool
-   <pool>.  */
-
-ffebit
-ffebit_new (mallocPool pool, ffebitCount size)
-{
-  ffebit b;
-
-  b = malloc_new_zks (pool, "ffebit",
-		      offsetof (struct _ffebit_, bits)
-		      + (size + CHAR_BIT - 1) / CHAR_BIT,
-		      0);
-  b->pool = pool;
-  b->size = size;
-
-  return b;
-}
-
-/* ffebit_set -- Set value of # of bits
-
-   ffebit b;  // the ffebit object
-   ffebitCount offset;	// 0..size-1
-   bool value;	// FALSE (0), TRUE (1)
-   ffebitCount length;	// # bits to set starting at offset (usually 1)
-   ffebit_set(b,offset,value,length);
-
-   Sets bit #s <offset> through <offset + length - 1> to <value>.  */
-
-void
-ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length)
-{
-  ffebitCount i;
-  ffebitCount element;
-  ffebitCount bitno;
-
-  assert (offset + length <= b->size);
-
-  for (i = 0; i < length; ++i, ++offset)
-    {
-      element = offset / CHAR_BIT;
-      bitno = offset % CHAR_BIT;
-      b->bits[element] = (((unsigned char) (value ? 1 : 0)) << bitno)
-	| (b->bits[element] & ~((unsigned char) 1 << bitno));
-    }
-}
-
-/* ffebit_test -- Test value of # of bits
-
-   ffebit b;  // the ffebit object
-   ffebitCount offset;	// 0..size-1
-   bool value;	// FALSE (0), TRUE (1)
-   ffebitCount length;	// # bits with same value
-   ffebit_test(b,offset,&value,&length);
-
-   Returns value of bits at <offset> through <offset + length - 1> in
-   <value>.  If <offset> is already at the end of the bit array (if
-   offset == ffebit_size(b)), <length> is set to 0 and <value> is
-   undefined.  */
-
-void
-ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length)
-{
-  ffebitCount i;
-  ffebitCount element;
-  ffebitCount bitno;
-
-  if (offset >= b->size)
-    {
-      assert (offset == b->size);
-      *length = 0;
-      return;
-    }
-
-  element = offset / CHAR_BIT;
-  bitno = offset % CHAR_BIT;
-  *value = (b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE;
-  *length = 1;
-
-  for (i = b->size - offset - 1, ++offset; i != 0; --i, ++offset, ++*length)
-    {
-      element = offset / CHAR_BIT;
-      bitno = offset % CHAR_BIT;
-      if (*value
-	  != ((b->bits[element] & ((unsigned char) 1 << bitno)) == 0 ? FALSE : TRUE))
-	break;
-    }
-}
diff --git a/gcc/f/bit.h b/gcc/f/bit.h
deleted file mode 100644
index 6b559ef..0000000
--- a/gcc/f/bit.h
+++ /dev/null
@@ -1,84 +0,0 @@
-/* bit.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      bit.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_BIT_H
-#define GCC_F_BIT_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-typedef struct _ffebit_ *ffebit;
-typedef unsigned long ffebitCount;
-#define ffebitCount_f "l"
-
-/* Include files needed by this one. */
-
-#include "malloc.h"
-
-/* Structure definitions. */
-
-struct _ffebit_
-  {
-    mallocPool pool;
-    ffebitCount size;
-    unsigned char bits[1];
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffebit_count (ffebit b, ffebitCount offset, bool value, ffebitCount range,
-		   ffebitCount *number);
-void ffebit_kill (ffebit b);
-ffebit ffebit_new (mallocPool pool, ffebitCount size);
-void ffebit_set (ffebit b, ffebitCount offset, bool value, ffebitCount length);
-void ffebit_test (ffebit b, ffebitCount offset, bool *value, ffebitCount *length);
-
-/* Define macros. */
-
-#define ffebit_init_0()
-#define ffebit_init_1()
-#define ffebit_init_2()
-#define ffebit_init_3()
-#define ffebit_init_4()
-#define ffebit_pool(b) ((b)->pool)
-#define ffebit_size(b) ((b)->size)
-#define ffebit_terminate_0()
-#define ffebit_terminate_1()
-#define ffebit_terminate_2()
-#define ffebit_terminate_3()
-#define ffebit_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_BIT_H */
diff --git a/gcc/f/bld-op.def b/gcc/f/bld-op.def
deleted file mode 100644
index 737dcc7..0000000
--- a/gcc/f/bld-op.def
+++ /dev/null
@@ -1,69 +0,0 @@
-/* bld-op.def -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      bad.c
-
-   Modifications:
-*/
-
-FFEBLD_OP (FFEBLD_opANY, "ANY", 0)
-FFEBLD_OP (FFEBLD_opSTAR, "STAR", 0)	/* For adjustable arrays, alternate return dummies, etc. */
-FFEBLD_OP (FFEBLD_opCONTER, "CONTER", 0)
-FFEBLD_OP (FFEBLD_opARRTER, "ARRTER", 0)	/* Array of constants (DATA...). */
-FFEBLD_OP (FFEBLD_opACCTER, "ACCTER", 0)	/* Accreting ARRTER. */
-FFEBLD_OP (FFEBLD_opSYMTER, "SYMTER", 0)
-FFEBLD_OP (FFEBLD_opITEM, "ITEM", 0)
-FFEBLD_OP (FFEBLD_opUPLUS, "UPLUS", 1)
-FFEBLD_OP (FFEBLD_opUMINUS, "UMINUS", 1)
-FFEBLD_OP (FFEBLD_opADD, "ADD", 2)
-FFEBLD_OP (FFEBLD_opSUBTRACT, "SUBTRACT", 2)
-FFEBLD_OP (FFEBLD_opMULTIPLY, "MULTIPLY", 2)
-FFEBLD_OP (FFEBLD_opDIVIDE, "DIVIDE", 2)
-FFEBLD_OP (FFEBLD_opPOWER, "POWER", 2)
-FFEBLD_OP (FFEBLD_opCONCATENATE, "CONCATENATE", 2)
-FFEBLD_OP (FFEBLD_opNOT, "NOT", 1)
-FFEBLD_OP (FFEBLD_opLT, "LT", 2)
-FFEBLD_OP (FFEBLD_opLE, "LE", 2)
-FFEBLD_OP (FFEBLD_opEQ, "EQ", 2)
-FFEBLD_OP (FFEBLD_opNE, "NE", 2)
-FFEBLD_OP (FFEBLD_opGT, "GT", 2)
-FFEBLD_OP (FFEBLD_opGE, "GE", 2)
-FFEBLD_OP (FFEBLD_opAND, "AND", 2)
-FFEBLD_OP (FFEBLD_opOR, "OR", 2)
-FFEBLD_OP (FFEBLD_opXOR, "XOR", 2)
-FFEBLD_OP (FFEBLD_opEQV, "EQV", 2)
-FFEBLD_OP (FFEBLD_opNEQV, "NEQV", 2)
-FFEBLD_OP (FFEBLD_opPAREN, "PAREN", 1)
-FFEBLD_OP (FFEBLD_opPERCENT_LOC, "%LOC", 1)
-FFEBLD_OP (FFEBLD_opPERCENT_VAL, "%VAL", 1)
-FFEBLD_OP (FFEBLD_opPERCENT_REF, "%REF", 1)
-FFEBLD_OP (FFEBLD_opPERCENT_DESCR, "%DESCR", 1)
-FFEBLD_OP (FFEBLD_opCONVERT, "CONVERT", 1)
-FFEBLD_OP (FFEBLD_opREPEAT, "REPEAT", 2)
-FFEBLD_OP (FFEBLD_opBOUNDS, "BOUNDS", 2)	/* For low:high in dimension lists. */
-FFEBLD_OP (FFEBLD_opFUNCREF, "FUNCREF", 2)
-FFEBLD_OP (FFEBLD_opSUBRREF, "SUBRREF", 2)
-FFEBLD_OP (FFEBLD_opARRAYREF, "ARRAYREF", 2)
-FFEBLD_OP (FFEBLD_opSUBSTR, "SUBSTR", 2)
-FFEBLD_OP (FFEBLD_opLABTER, "LABTER", 0)
-FFEBLD_OP (FFEBLD_opLABTOK, "LABTOK", 0)	/* Like LABTER but contains ffelexToken instead. */
-FFEBLD_OP (FFEBLD_opIMPDO, "IMPDO", 2)
diff --git a/gcc/f/bld.c b/gcc/f/bld.c
deleted file mode 100644
index 6f96f5b..0000000
--- a/gcc/f/bld.c
+++ /dev/null
@@ -1,2809 +0,0 @@
-/* bld.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      The primary "output" of the FFE includes ffebld objects, which
-      connect expressions, operators, and operands together, along with
-      connecting lists of expressions together for argument or dimension
-      lists.
-
-   Modifications:
-      30-Aug-92	 JCB  1.1
-	 Change names of some things for consistency.
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "bld.h"
-#include "bit.h"
-#include "info.h"
-#include "lex.h"
-#include "malloc.h"
-#include "target.h"
-#include "where.h"
-#include "real.h"
-
-/* Externals defined here.  */
-
-const ffebldArity ffebld_arity_op_[(int) FFEBLD_op]
-=
-{
-#define FFEBLD_OP(KWD,NAME,ARITY) ARITY,
-#include "bld-op.def"
-#undef FFEBLD_OP
-};
-struct _ffebld_pool_stack_ ffebld_pool_stack_;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module.	 */
-
-#if FFETARGET_okCHARACTER1
-static ffebldConstant ffebld_constant_character1_;
-#endif
-#if FFETARGET_okCOMPLEX1
-static ffebldConstant ffebld_constant_complex1_;
-#endif
-#if FFETARGET_okCOMPLEX2
-static ffebldConstant ffebld_constant_complex2_;
-#endif
-#if FFETARGET_okCOMPLEX3
-static ffebldConstant ffebld_constant_complex3_;
-#endif
-#if FFETARGET_okINTEGER1
-static ffebldConstant ffebld_constant_integer1_;
-#endif
-#if FFETARGET_okINTEGER2
-static ffebldConstant ffebld_constant_integer2_;
-#endif
-#if FFETARGET_okINTEGER3
-static ffebldConstant ffebld_constant_integer3_;
-#endif
-#if FFETARGET_okINTEGER4
-static ffebldConstant ffebld_constant_integer4_;
-#endif
-#if FFETARGET_okLOGICAL1
-static ffebldConstant ffebld_constant_logical1_;
-#endif
-#if FFETARGET_okLOGICAL2
-static ffebldConstant ffebld_constant_logical2_;
-#endif
-#if FFETARGET_okLOGICAL3
-static ffebldConstant ffebld_constant_logical3_;
-#endif
-#if FFETARGET_okLOGICAL4
-static ffebldConstant ffebld_constant_logical4_;
-#endif
-#if FFETARGET_okREAL1
-static ffebldConstant ffebld_constant_real1_;
-#endif
-#if FFETARGET_okREAL2
-static ffebldConstant ffebld_constant_real2_;
-#endif
-#if FFETARGET_okREAL3
-static ffebldConstant ffebld_constant_real3_;
-#endif
-static ffebldConstant ffebld_constant_hollerith_;
-static ffebldConstant ffebld_constant_typeless_[FFEBLD_constTYPELESS_LAST
-					  - FFEBLD_constTYPELESS_FIRST + 1];
-
-static const char *const ffebld_op_string_[]
-=
-{
-#define FFEBLD_OP(KWD,NAME,ARITY) NAME,
-#include "bld-op.def"
-#undef FFEBLD_OP
-};
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-#define integerdefault_ CATX(integer,FFETARGET_ktINTEGERDEFAULT)
-#define logicaldefault_ CATX(logical,FFETARGET_ktLOGICALDEFAULT)
-#define realdefault_ CATX(real,FFETARGET_ktREALDEFAULT)
-#define realdouble_ CATX(real,FFETARGET_ktREALDOUBLE)
-#define realquad_ CATX(real,FFETARGET_ktREALQUAD)
-
-/* ffebld_constant_cmp -- Compare two constants a la strcmp
-
-   ffebldConstant c1, c2;
-   if (ffebld_constant_cmp(c1,c2) == 0)
-       // they're equal, else they're not.
-
-   Returns -1 if c1 < c2, 0 if c1 == c2, +1 if c1 == c2.  */
-
-int
-ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2)
-{
-  if (c1 == c2)
-    return 0;
-
-  assert (ffebld_constant_type (c1) == ffebld_constant_type (c2));
-
-  switch (ffebld_constant_type (c1))
-    {
-#if FFETARGET_okINTEGER1
-    case FFEBLD_constINTEGER1:
-      return ffetarget_cmp_integer1 (ffebld_constant_integer1 (c1),
-				     ffebld_constant_integer1 (c2));
-#endif
-
-#if FFETARGET_okINTEGER2
-    case FFEBLD_constINTEGER2:
-      return ffetarget_cmp_integer2 (ffebld_constant_integer2 (c1),
-				     ffebld_constant_integer2 (c2));
-#endif
-
-#if FFETARGET_okINTEGER3
-    case FFEBLD_constINTEGER3:
-      return ffetarget_cmp_integer3 (ffebld_constant_integer3 (c1),
-				     ffebld_constant_integer3 (c2));
-#endif
-
-#if FFETARGET_okINTEGER4
-    case FFEBLD_constINTEGER4:
-      return ffetarget_cmp_integer4 (ffebld_constant_integer4 (c1),
-				     ffebld_constant_integer4 (c2));
-#endif
-
-#if FFETARGET_okLOGICAL1
-    case FFEBLD_constLOGICAL1:
-      return ffetarget_cmp_logical1 (ffebld_constant_logical1 (c1),
-				     ffebld_constant_logical1 (c2));
-#endif
-
-#if FFETARGET_okLOGICAL2
-    case FFEBLD_constLOGICAL2:
-      return ffetarget_cmp_logical2 (ffebld_constant_logical2 (c1),
-				     ffebld_constant_logical2 (c2));
-#endif
-
-#if FFETARGET_okLOGICAL3
-    case FFEBLD_constLOGICAL3:
-      return ffetarget_cmp_logical3 (ffebld_constant_logical3 (c1),
-				     ffebld_constant_logical3 (c2));
-#endif
-
-#if FFETARGET_okLOGICAL4
-    case FFEBLD_constLOGICAL4:
-      return ffetarget_cmp_logical4 (ffebld_constant_logical4 (c1),
-				     ffebld_constant_logical4 (c2));
-#endif
-
-#if FFETARGET_okREAL1
-    case FFEBLD_constREAL1:
-      return ffetarget_cmp_real1 (ffebld_constant_real1 (c1),
-				  ffebld_constant_real1 (c2));
-#endif
-
-#if FFETARGET_okREAL2
-    case FFEBLD_constREAL2:
-      return ffetarget_cmp_real2 (ffebld_constant_real2 (c1),
-				  ffebld_constant_real2 (c2));
-#endif
-
-#if FFETARGET_okREAL3
-    case FFEBLD_constREAL3:
-      return ffetarget_cmp_real3 (ffebld_constant_real3 (c1),
-				  ffebld_constant_real3 (c2));
-#endif
-
-#if FFETARGET_okCHARACTER1
-    case FFEBLD_constCHARACTER1:
-      return ffetarget_cmp_character1 (ffebld_constant_character1 (c1),
-				       ffebld_constant_character1 (c2));
-#endif
-
-    default:
-      assert ("bad constant type" == NULL);
-      return 0;
-    }
-}
-
-/* ffebld_constant_is_magical -- Determine if integer is "magical"
-
-   ffebldConstant c;
-   if (ffebld_constant_is_magical(c))
-       // it is 2**(n-1), where n is # bits in ffetargetIntegerDefault type
-       // (this test is important for 2's-complement machines only).  */
-
-bool
-ffebld_constant_is_magical (ffebldConstant c)
-{
-  switch (ffebld_constant_type (c))
-    {
-    case FFEBLD_constINTEGERDEFAULT:
-      return ffetarget_integerdefault_is_magical (ffebld_constant_integer1 (c));
-
-    default:
-      return FALSE;
-    }
-}
-
-/* Determine if constant is zero.  Used to ensure step count
-   for DO loops isn't zero, also to determine if values will
-   be binary zeros, so not entirely portable at this point.  */
-
-bool
-ffebld_constant_is_zero (ffebldConstant c)
-{
-  switch (ffebld_constant_type (c))
-    {
-#if FFETARGET_okINTEGER1
-    case FFEBLD_constINTEGER1:
-      return ffebld_constant_integer1 (c) == 0;
-#endif
-
-#if FFETARGET_okINTEGER2
-    case FFEBLD_constINTEGER2:
-      return ffebld_constant_integer2 (c) == 0;
-#endif
-
-#if FFETARGET_okINTEGER3
-    case FFEBLD_constINTEGER3:
-      return ffebld_constant_integer3 (c) == 0;
-#endif
-
-#if FFETARGET_okINTEGER4
-    case FFEBLD_constINTEGER4:
-      return ffebld_constant_integer4 (c) == 0;
-#endif
-
-#if FFETARGET_okLOGICAL1
-    case FFEBLD_constLOGICAL1:
-      return ffebld_constant_logical1 (c) == 0;
-#endif
-
-#if FFETARGET_okLOGICAL2
-    case FFEBLD_constLOGICAL2:
-      return ffebld_constant_logical2 (c) == 0;
-#endif
-
-#if FFETARGET_okLOGICAL3
-    case FFEBLD_constLOGICAL3:
-      return ffebld_constant_logical3 (c) == 0;
-#endif
-
-#if FFETARGET_okLOGICAL4
-    case FFEBLD_constLOGICAL4:
-      return ffebld_constant_logical4 (c) == 0;
-#endif
-
-#if FFETARGET_okREAL1
-    case FFEBLD_constREAL1:
-      return ffetarget_iszero_real1 (ffebld_constant_real1 (c));
-#endif
-
-#if FFETARGET_okREAL2
-    case FFEBLD_constREAL2:
-      return ffetarget_iszero_real2 (ffebld_constant_real2 (c));
-#endif
-
-#if FFETARGET_okREAL3
-    case FFEBLD_constREAL3:
-      return ffetarget_iszero_real3 (ffebld_constant_real3 (c));
-#endif
-
-#if FFETARGET_okCOMPLEX1
-    case FFEBLD_constCOMPLEX1:
-      return ffetarget_iszero_real1 (ffebld_constant_complex1 (c).real)
-     && ffetarget_iszero_real1 (ffebld_constant_complex1 (c).imaginary);
-#endif
-
-#if FFETARGET_okCOMPLEX2
-    case FFEBLD_constCOMPLEX2:
-      return ffetarget_iszero_real2 (ffebld_constant_complex2 (c).real)
-     && ffetarget_iszero_real2 (ffebld_constant_complex2 (c).imaginary);
-#endif
-
-#if FFETARGET_okCOMPLEX3
-    case FFEBLD_constCOMPLEX3:
-      return ffetarget_iszero_real3 (ffebld_constant_complex3 (c).real)
-     && ffetarget_iszero_real3 (ffebld_constant_complex3 (c).imaginary);
-#endif
-
-#if FFETARGET_okCHARACTER1
-    case FFEBLD_constCHARACTER1:
-      return ffetarget_iszero_character1 (ffebld_constant_character1 (c));
-#endif
-
-    case FFEBLD_constHOLLERITH:
-      return ffetarget_iszero_hollerith (ffebld_constant_hollerith (c));
-
-    case FFEBLD_constBINARY_MIL:
-    case FFEBLD_constBINARY_VXT:
-    case FFEBLD_constOCTAL_MIL:
-    case FFEBLD_constOCTAL_VXT:
-    case FFEBLD_constHEX_X_MIL:
-    case FFEBLD_constHEX_X_VXT:
-    case FFEBLD_constHEX_Z_MIL:
-    case FFEBLD_constHEX_Z_VXT:
-      return ffetarget_iszero_typeless (ffebld_constant_typeless (c));
-
-    default:
-      return FALSE;
-    }
-}
-
-/* ffebld_constant_new_character1 -- Return character1 constant object from token
-
-   See prototype.  */
-
-#if FFETARGET_okCHARACTER1
-ffebldConstant
-ffebld_constant_new_character1 (ffelexToken t)
-{
-  ffetargetCharacter1 val;
-
-  ffetarget_character1 (&val, t, ffebld_constant_pool());
-  return ffebld_constant_new_character1_val (val);
-}
-
-#endif
-/* ffebld_constant_new_character1_val -- Return an character1 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okCHARACTER1
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constCHARACTER1",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constCHARACTER1;
-  nc->u.character1 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_complex1 -- Return complex1 constant object from token
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX1
-ffebldConstant
-ffebld_constant_new_complex1 (ffebldConstant real,
-			      ffebldConstant imaginary)
-{
-  ffetargetComplex1 val;
-
-  val.real = ffebld_constant_real1 (real);
-  val.imaginary = ffebld_constant_real1 (imaginary);
-  return ffebld_constant_new_complex1_val (val);
-}
-
-#endif
-/* ffebld_constant_new_complex1_val -- Return a complex1 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX1
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constCOMPLEX1",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constCOMPLEX1;
-  nc->u.complex1 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_complex2 -- Return complex2 constant object from token
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX2
-ffebldConstant
-ffebld_constant_new_complex2 (ffebldConstant real,
-			      ffebldConstant imaginary)
-{
-  ffetargetComplex2 val;
-
-  val.real = ffebld_constant_real2 (real);
-  val.imaginary = ffebld_constant_real2 (imaginary);
-  return ffebld_constant_new_complex2_val (val);
-}
-
-#endif
-/* ffebld_constant_new_complex2_val -- Return a complex2 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX2
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constCOMPLEX2",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constCOMPLEX2;
-  nc->u.complex2 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_hollerith -- Return hollerith constant object from token
-
-   See prototype.  */
-
-ffebldConstant
-ffebld_constant_new_hollerith (ffelexToken t)
-{
-  ffetargetHollerith val;
-
-  ffetarget_hollerith (&val, t, ffebld_constant_pool());
-  return ffebld_constant_new_hollerith_val (val);
-}
-
-/* ffebld_constant_new_hollerith_val -- Return an hollerith constant object
-
-   See prototype.  */
-
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constHOLLERITH",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constHOLLERITH;
-  nc->u.hollerith = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-/* ffebld_constant_new_integer1 -- Return integer1 constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-#if FFETARGET_okINTEGER1
-ffebldConstant
-ffebld_constant_new_integer1 (ffelexToken t)
-{
-  ffetargetInteger1 val;
-
-  assert (ffelex_token_type (t) == FFELEX_typeNUMBER);
-
-  ffetarget_integer1 (&val, t);
-  return ffebld_constant_new_integer1_val (val);
-}
-
-#endif
-/* ffebld_constant_new_integer1_val -- Return an integer1 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okINTEGER1
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constINTEGER1",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constINTEGER1;
-  nc->u.integer1 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_integer2_val -- Return an integer2 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okINTEGER2
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constINTEGER2",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constINTEGER2;
-  nc->u.integer2 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_integer3_val -- Return an integer3 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okINTEGER3
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constINTEGER3",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constINTEGER3;
-  nc->u.integer3 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_integer4_val -- Return an integer4 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okINTEGER4
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constINTEGER4",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constINTEGER4;
-  nc->u.integer4 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_integerbinary -- Return binary constant object from token
-
-   See prototype.
-
-   Parses the token as a binary integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_integerbinary (ffelexToken t)
-{
-  ffetargetIntegerDefault val;
-
-  assert ((ffelex_token_type (t) == FFELEX_typeNAME)
-	  || (ffelex_token_type (t) == FFELEX_typeNUMBER));
-
-  ffetarget_integerbinary (&val, t);
-  return ffebld_constant_new_integerdefault_val (val);
-}
-
-/* ffebld_constant_new_integerhex -- Return hex constant object from token
-
-   See prototype.
-
-   Parses the token as a hex integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_integerhex (ffelexToken t)
-{
-  ffetargetIntegerDefault val;
-
-  assert ((ffelex_token_type (t) == FFELEX_typeNAME)
-	  || (ffelex_token_type (t) == FFELEX_typeNUMBER));
-
-  ffetarget_integerhex (&val, t);
-  return ffebld_constant_new_integerdefault_val (val);
-}
-
-/* ffebld_constant_new_integeroctal -- Return octal constant object from token
-
-   See prototype.
-
-   Parses the token as a octal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_integeroctal (ffelexToken t)
-{
-  ffetargetIntegerDefault val;
-
-  assert ((ffelex_token_type (t) == FFELEX_typeNAME)
-	  || (ffelex_token_type (t) == FFELEX_typeNUMBER));
-
-  ffetarget_integeroctal (&val, t);
-  return ffebld_constant_new_integerdefault_val (val);
-}
-
-/* ffebld_constant_new_logical1 -- Return logical1 constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal logical constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-#if FFETARGET_okLOGICAL1
-ffebldConstant
-ffebld_constant_new_logical1 (bool truth)
-{
-  ffetargetLogical1 val;
-
-  ffetarget_logical1 (&val, truth);
-  return ffebld_constant_new_logical1_val (val);
-}
-
-#endif
-/* ffebld_constant_new_logical1_val -- Return a logical1 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okLOGICAL1
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constLOGICAL1",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constLOGICAL1;
-  nc->u.logical1 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_logical2_val -- Return a logical2 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okLOGICAL2
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constLOGICAL2",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constLOGICAL2;
-  nc->u.logical2 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_logical3_val -- Return a logical3 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okLOGICAL3
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constLOGICAL3",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constLOGICAL3;
-  nc->u.logical3 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_logical4_val -- Return a logical4 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okLOGICAL4
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constLOGICAL4",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constLOGICAL4;
-  nc->u.logical4 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_real1 -- Return real1 constant object from token
-
-   See prototype.  */
-
-#if FFETARGET_okREAL1
-ffebldConstant
-ffebld_constant_new_real1 (ffelexToken integer, ffelexToken decimal,
-      ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
-			   ffelexToken exponent_digits)
-{
-  ffetargetReal1 val;
-
-  ffetarget_real1 (&val,
-      integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
-  return ffebld_constant_new_real1_val (val);
-}
-
-#endif
-/* ffebld_constant_new_real1_val -- Return an real1 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okREAL1
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constREAL1",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constREAL1;
-  nc->u.real1 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_real2 -- Return real2 constant object from token
-
-   See prototype.  */
-
-#if FFETARGET_okREAL2
-ffebldConstant
-ffebld_constant_new_real2 (ffelexToken integer, ffelexToken decimal,
-      ffelexToken fraction, ffelexToken exponent, ffelexToken exponent_sign,
-			   ffelexToken exponent_digits)
-{
-  ffetargetReal2 val;
-
-  ffetarget_real2 (&val,
-      integer, decimal, fraction, exponent, exponent_sign, exponent_digits);
-  return ffebld_constant_new_real2_val (val);
-}
-
-#endif
-/* ffebld_constant_new_real2_val -- Return an real2 constant object
-
-   See prototype.  */
-
-#if FFETARGET_okREAL2
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constREAL2",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = FFEBLD_constREAL2;
-  nc->u.real2 = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-#endif
-/* ffebld_constant_new_typeless_bm -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_bm (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_binarymil (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_MIL, val);
-}
-
-/* ffebld_constant_new_typeless_bv -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_bv (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_binaryvxt (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constBINARY_VXT, val);
-}
-
-/* ffebld_constant_new_typeless_hxm -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_hxm (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_hexxmil (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_MIL, val);
-}
-
-/* ffebld_constant_new_typeless_hxv -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_hxv (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_hexxvxt (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_X_VXT, val);
-}
-
-/* ffebld_constant_new_typeless_hzm -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_hzm (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_hexzmil (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_MIL, val);
-}
-
-/* ffebld_constant_new_typeless_hzv -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_hzv (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_hexzvxt (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constHEX_Z_VXT, val);
-}
-
-/* ffebld_constant_new_typeless_om -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_om (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_octalmil (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_MIL, val);
-}
-
-/* ffebld_constant_new_typeless_ov -- Return typeless constant object from token
-
-   See prototype.
-
-   Parses the token as a decimal integer constant, thus it must be an
-   FFELEX_typeNUMBER.  */
-
-ffebldConstant
-ffebld_constant_new_typeless_ov (ffelexToken t)
-{
-  ffetargetTypeless val;
-
-  ffetarget_octalvxt (&val, t);
-  return ffebld_constant_new_typeless_val (FFEBLD_constOCTAL_VXT, val);
-}
-
-/* ffebld_constant_new_typeless_val -- Return a typeless constant object
-
-   See prototype.  */
-
-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;
-    }
-
-  nc = malloc_new_kp (ffebld_constant_pool(),
-		      "FFEBLD_constTYPELESS",
-		      sizeof (*nc));
-  nc->next = c->next;
-  nc->consttype = type;
-  nc->u.typeless = val;
-  nc->hook = FFECOM_constantNULL;
-  c->next = nc;
-
-  return nc;
-}
-
-/* ffebld_constantarray_get -- Get a value from an array of constants
-
-   See prototype.  */
-
-ffebldConstantUnion
-ffebld_constantarray_get (ffebldConstantArray array, ffeinfoBasictype bt,
-			  ffeinfoKindtype kt, ffetargetOffset offset)
-{
-  ffebldConstantUnion u;
-
-  switch (bt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (kt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  u.integer1 = *(array.integer1 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  u.integer2 = *(array.integer2 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  u.integer3 = *(array.integer3 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  u.integer4 = *(array.integer4 + offset);
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  u.logical1 = *(array.logical1 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  u.logical2 = *(array.logical2 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  u.logical3 = *(array.logical3 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  u.logical4 = *(array.logical4 + offset);
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  u.real1 = *(array.real1 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  u.real2 = *(array.real2 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  u.real3 = *(array.real3 + offset);
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  u.complex1 = *(array.complex1 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  u.complex2 = *(array.complex2 + offset);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  u.complex3 = *(array.complex3 + offset);
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (kt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  u.character1.length = 1;
-	  u.character1.text = array.character1 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad basictype" == NULL);
-      break;
-    }
-
-  return u;
-}
-
-/* ffebld_constantarray_new -- Make an array of constants
-
-   See prototype.  */
-
-ffebldConstantArray
-ffebld_constantarray_new (ffeinfoBasictype bt,
-			  ffeinfoKindtype kt, ffetargetOffset size)
-{
-  ffebldConstantArray ptr;
-
-  switch (bt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (kt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  ptr.integer1 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetInteger1),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  ptr.integer2 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetInteger2),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  ptr.integer3 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetInteger3),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  ptr.integer4 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetInteger4),
-					 0);
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  ptr.logical1 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetLogical1),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  ptr.logical2 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetLogical2),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  ptr.logical3 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetLogical3),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  ptr.logical4 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetLogical4),
-					 0);
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  ptr.real1 = malloc_new_zkp (ffebld_constant_pool(),
-				      "ffebldConstantArray",
-				      size *= sizeof (ffetargetReal1),
-				      0);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  ptr.real2 = malloc_new_zkp (ffebld_constant_pool(),
-				      "ffebldConstantArray",
-				      size *= sizeof (ffetargetReal2),
-				      0);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  ptr.real3 = malloc_new_zkp (ffebld_constant_pool(),
-				      "ffebldConstantArray",
-				      size *= sizeof (ffetargetReal3),
-				      0);
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  ptr.complex1 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetComplex1),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  ptr.complex2 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetComplex2),
-					 0);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  ptr.complex3 = malloc_new_zkp (ffebld_constant_pool(),
-					 "ffebldConstantArray",
-					 size *= sizeof (ffetargetComplex3),
-					 0);
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (kt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  ptr.character1 = malloc_new_zkp (ffebld_constant_pool(),
-					   "ffebldConstantArray",
-					   size
-					   *= sizeof (ffetargetCharacterUnit1),
-					   0);
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad basictype" == NULL);
-      break;
-    }
-
-  return ptr;
-}
-
-/* ffebld_constantarray_preparray -- Prepare for copy between arrays
-
-   See prototype.
-
-   Like _prepare, but the source is an array instead of a single-value
-   constant.  */
-
-void
-ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
-       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
-		   ffetargetOffset offset, ffebldConstantArray source_array,
-				ffeinfoBasictype cbt, ffeinfoKindtype ckt)
-{
-  switch (abt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (akt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  *aptr = array.integer1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  *aptr = array.integer2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  *aptr = array.integer3 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  *aptr = array.integer4 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (akt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  *aptr = array.logical1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  *aptr = array.logical2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  *aptr = array.logical3 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  *aptr = array.logical4 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (akt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  *aptr = array.real1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  *aptr = array.real2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  *aptr = array.real3 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (akt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  *aptr = array.complex1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  *aptr = array.complex2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  *aptr = array.complex3 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (akt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  *aptr = array.character1 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad abasictype" == NULL);
-      break;
-    }
-
-  switch (cbt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (ckt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  *cptr = source_array.integer1;
-	  *size = sizeof (*source_array.integer1);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  *cptr = source_array.integer2;
-	  *size = sizeof (*source_array.integer2);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  *cptr = source_array.integer3;
-	  *size = sizeof (*source_array.integer3);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  *cptr = source_array.integer4;
-	  *size = sizeof (*source_array.integer4);
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (ckt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  *cptr = source_array.logical1;
-	  *size = sizeof (*source_array.logical1);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  *cptr = source_array.logical2;
-	  *size = sizeof (*source_array.logical2);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  *cptr = source_array.logical3;
-	  *size = sizeof (*source_array.logical3);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  *cptr = source_array.logical4;
-	  *size = sizeof (*source_array.logical4);
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ckt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  *cptr = source_array.real1;
-	  *size = sizeof (*source_array.real1);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  *cptr = source_array.real2;
-	  *size = sizeof (*source_array.real2);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  *cptr = source_array.real3;
-	  *size = sizeof (*source_array.real3);
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (ckt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  *cptr = source_array.complex1;
-	  *size = sizeof (*source_array.complex1);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  *cptr = source_array.complex2;
-	  *size = sizeof (*source_array.complex2);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  *cptr = source_array.complex3;
-	  *size = sizeof (*source_array.complex3);
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ckt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  *cptr = source_array.character1;
-	  *size = sizeof (*source_array.character1);
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad cbasictype" == NULL);
-      break;
-    }
-}
-
-/* ffebld_constantarray_prepare -- Prepare for copy between value and array
-
-   See prototype.
-
-   Like _put, but just returns the pointers to the beginnings of the
-   array and the constant and returns the size (the amount of info to
-   copy).  The idea is that the caller can use memcpy to accomplish the
-   same thing as _put (though slower), or the caller can use a different
-   function that swaps bytes, words, etc for a different target machine.
-   Also, the type of the array may be different from the type of the
-   constant; the array type is used to determine the meaning (scale) of
-   the offset field (to calculate the array pointer), the constant type is
-   used to determine the constant pointer and the size (amount of info to
-   copy).  */
-
-void
-ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
-       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
-		      ffetargetOffset offset, ffebldConstantUnion *constant,
-			      ffeinfoBasictype cbt, ffeinfoKindtype ckt)
-{
-  switch (abt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (akt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  *aptr = array.integer1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  *aptr = array.integer2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  *aptr = array.integer3 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  *aptr = array.integer4 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (akt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  *aptr = array.logical1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  *aptr = array.logical2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  *aptr = array.logical3 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  *aptr = array.logical4 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (akt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  *aptr = array.real1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  *aptr = array.real2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  *aptr = array.real3 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (akt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  *aptr = array.complex1 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  *aptr = array.complex2 + offset;
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  *aptr = array.complex3 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (akt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  *aptr = array.character1 + offset;
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER akindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad abasictype" == NULL);
-      break;
-    }
-
-  switch (cbt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (ckt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  *cptr = &constant->integer1;
-	  *size = sizeof (constant->integer1);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  *cptr = &constant->integer2;
-	  *size = sizeof (constant->integer2);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  *cptr = &constant->integer3;
-	  *size = sizeof (constant->integer3);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  *cptr = &constant->integer4;
-	  *size = sizeof (constant->integer4);
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (ckt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  *cptr = &constant->logical1;
-	  *size = sizeof (constant->logical1);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  *cptr = &constant->logical2;
-	  *size = sizeof (constant->logical2);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  *cptr = &constant->logical3;
-	  *size = sizeof (constant->logical3);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  *cptr = &constant->logical4;
-	  *size = sizeof (constant->logical4);
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ckt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  *cptr = &constant->real1;
-	  *size = sizeof (constant->real1);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  *cptr = &constant->real2;
-	  *size = sizeof (constant->real2);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  *cptr = &constant->real3;
-	  *size = sizeof (constant->real3);
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (ckt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  *cptr = &constant->complex1;
-	  *size = sizeof (constant->complex1);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  *cptr = &constant->complex2;
-	  *size = sizeof (constant->complex2);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  *cptr = &constant->complex3;
-	  *size = sizeof (constant->complex3);
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ckt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  *cptr = ffetarget_text_character1 (constant->character1);
-	  *size = ffetarget_length_character1 (constant->character1);
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER ckindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad cbasictype" == NULL);
-      break;
-    }
-}
-
-/* ffebld_constantarray_put -- Put a value into an array of constants
-
-   See prototype.  */
-
-void
-ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
-   ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant)
-{
-  switch (bt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      switch (kt)
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  *(array.integer1 + offset) = constant.integer1;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  *(array.integer2 + offset) = constant.integer2;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  *(array.integer3 + offset) = constant.integer3;
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  *(array.integer4 + offset) = constant.integer4;
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt)
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  *(array.logical1 + offset) = constant.logical1;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  *(array.logical2 + offset) = constant.logical2;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  *(array.logical3 + offset) = constant.logical3;
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  *(array.logical4 + offset) = constant.logical4;
-	  break;
-#endif
-
-	default:
-	  assert ("bad LOGICAL kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt)
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  *(array.real1 + offset) = constant.real1;
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  *(array.real2 + offset) = constant.real2;
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  *(array.real3 + offset) = constant.real3;
-	  break;
-#endif
-
-	default:
-	  assert ("bad REAL kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  *(array.complex1 + offset) = constant.complex1;
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  *(array.complex2 + offset) = constant.complex2;
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  *(array.complex3 + offset) = constant.complex3;
-	  break;
-#endif
-
-	default:
-	  assert ("bad COMPLEX kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (kt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  memcpy (array.character1 + offset,
-		  ffetarget_text_character1 (constant.character1),
-		  ffetarget_length_character1 (constant.character1));
-	  break;
-#endif
-
-	default:
-	  assert ("bad CHARACTER kindtype" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad basictype" == NULL);
-      break;
-    }
-}
-
-/* ffebld_init_0 -- Initialize the module
-
-   ffebld_init_0();  */
-
-void
-ffebld_init_0 (void)
-{
-  assert (FFEBLD_op == ARRAY_SIZE (ffebld_op_string_));
-  assert (FFEBLD_op == ARRAY_SIZE (ffebld_arity_op_));
-}
-
-/* ffebld_init_1 -- Initialize the module for a file
-
-   ffebld_init_1();  */
-
-void
-ffebld_init_1 (void)
-{
-#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
-  int i;
-
-#if FFETARGET_okCHARACTER1
-  ffebld_constant_character1_ = NULL;
-#endif
-#if FFETARGET_okCOMPLEX1
-  ffebld_constant_complex1_ = NULL;
-#endif
-#if FFETARGET_okCOMPLEX2
-  ffebld_constant_complex2_ = NULL;
-#endif
-#if FFETARGET_okCOMPLEX3
-  ffebld_constant_complex3_ = NULL;
-#endif
-#if FFETARGET_okINTEGER1
-  ffebld_constant_integer1_ = NULL;
-#endif
-#if FFETARGET_okINTEGER2
-  ffebld_constant_integer2_ = NULL;
-#endif
-#if FFETARGET_okINTEGER3
-  ffebld_constant_integer3_ = NULL;
-#endif
-#if FFETARGET_okINTEGER4
-  ffebld_constant_integer4_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL1
-  ffebld_constant_logical1_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL2
-  ffebld_constant_logical2_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL3
-  ffebld_constant_logical3_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL4
-  ffebld_constant_logical4_ = NULL;
-#endif
-#if FFETARGET_okREAL1
-  ffebld_constant_real1_ = NULL;
-#endif
-#if FFETARGET_okREAL2
-  ffebld_constant_real2_ = NULL;
-#endif
-#if FFETARGET_okREAL3
-  ffebld_constant_real3_ = NULL;
-#endif
-  ffebld_constant_hollerith_ = NULL;
-  for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
-    ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
-#endif
-}
-
-/* ffebld_init_2 -- Initialize the module
-
-   ffebld_init_2();  */
-
-void
-ffebld_init_2 (void)
-{
-#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
-  int i;
-#endif
-
-  ffebld_pool_stack_.next = NULL;
-  ffebld_pool_stack_.pool = ffe_pool_program_unit ();
-#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
-#if FFETARGET_okCHARACTER1
-  ffebld_constant_character1_ = NULL;
-#endif
-#if FFETARGET_okCOMPLEX1
-  ffebld_constant_complex1_ = NULL;
-#endif
-#if FFETARGET_okCOMPLEX2
-  ffebld_constant_complex2_ = NULL;
-#endif
-#if FFETARGET_okCOMPLEX3
-  ffebld_constant_complex3_ = NULL;
-#endif
-#if FFETARGET_okINTEGER1
-  ffebld_constant_integer1_ = NULL;
-#endif
-#if FFETARGET_okINTEGER2
-  ffebld_constant_integer2_ = NULL;
-#endif
-#if FFETARGET_okINTEGER3
-  ffebld_constant_integer3_ = NULL;
-#endif
-#if FFETARGET_okINTEGER4
-  ffebld_constant_integer4_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL1
-  ffebld_constant_logical1_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL2
-  ffebld_constant_logical2_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL3
-  ffebld_constant_logical3_ = NULL;
-#endif
-#if FFETARGET_okLOGICAL4
-  ffebld_constant_logical4_ = NULL;
-#endif
-#if FFETARGET_okREAL1
-  ffebld_constant_real1_ = NULL;
-#endif
-#if FFETARGET_okREAL2
-  ffebld_constant_real2_ = NULL;
-#endif
-#if FFETARGET_okREAL3
-  ffebld_constant_real3_ = NULL;
-#endif
-  ffebld_constant_hollerith_ = NULL;
-  for (i = FFEBLD_constTYPELESS_FIRST; i <= FFEBLD_constTYPELESS_LAST; ++i)
-    ffebld_constant_typeless_[i - FFEBLD_constTYPELESS_FIRST] = NULL;
-#endif
-}
-
-/* ffebld_list_length -- Return # of opITEMs in list
-
-   ffebld list;	 // Must be NULL or opITEM
-   ffebldListLength length;
-   length = ffebld_list_length(list);
-
-   Returns 0 if list is NULL, 1 if it's ffebld_trail is NULL, and so on.  */
-
-ffebldListLength
-ffebld_list_length (ffebld list)
-{
-  ffebldListLength length;
-
-  for (length = 0; list != NULL; ++length, list = ffebld_trail (list))
-    ;
-
-  return length;
-}
-
-/* ffebld_new_accter -- Create an ffebld object that is an array
-
-   ffebld x;
-   ffebldConstantArray a;
-   ffebit b;
-   x = ffebld_new_accter(a,b);	*/
-
-ffebld
-ffebld_new_accter (ffebldConstantArray a, ffebit b)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opACCTER;
-  x->u.accter.array = a;
-  x->u.accter.bits = b;
-  x->u.accter.pad = 0;
-  return x;
-}
-
-/* ffebld_new_arrter -- Create an ffebld object that is an array
-
-   ffebld x;
-   ffebldConstantArray a;
-   ffetargetOffset size;
-   x = ffebld_new_arrter(a,size);  */
-
-ffebld
-ffebld_new_arrter (ffebldConstantArray a, ffetargetOffset size)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opARRTER;
-  x->u.arrter.array = a;
-  x->u.arrter.size = size;
-  x->u.arrter.pad = 0;
-  return x;
-}
-
-/* ffebld_new_conter_with_orig -- Create an ffebld object that is a constant
-
-   ffebld x;
-   ffebldConstant c;
-   x = ffebld_new_conter_with_orig(c,NULL);  */
-
-ffebld
-ffebld_new_conter_with_orig (ffebldConstant c, ffebld o)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opCONTER;
-  x->u.conter.expr = c;
-  x->u.conter.orig = o;
-  x->u.conter.pad = 0;
-  return x;
-}
-
-/* ffebld_new_item -- Create an ffebld item object
-
-   ffebld x,y,z;
-   x = ffebld_new_item(y,z);  */
-
-ffebld
-ffebld_new_item (ffebld head, ffebld trail)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opITEM;
-  x->u.item.head = head;
-  x->u.item.trail = trail;
-  return x;
-}
-
-/* ffebld_new_labter -- Create an ffebld object that is a label
-
-   ffebld x;
-   ffelab l;
-   x = ffebld_new_labter(c);  */
-
-ffebld
-ffebld_new_labter (ffelab l)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opLABTER;
-  x->u.labter = l;
-  return x;
-}
-
-/* ffebld_new_labtok -- Create object that is a label's NUMBER token
-
-   ffebld x;
-   ffelexToken t;
-   x = ffebld_new_labter(c);
-
-   Like the other ffebld_new_ functions, the
-   supplied argument is stored exactly as is: ffelex_token_use is NOT
-   called, so the token is "consumed", if one is indeed supplied (it may
-   be NULL).  */
-
-ffebld
-ffebld_new_labtok (ffelexToken t)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opLABTOK;
-  x->u.labtok = t;
-  return x;
-}
-
-/* ffebld_new_none -- Create an ffebld object with no arguments
-
-   ffebld x;
-   x = ffebld_new_none(FFEBLD_opWHATEVER);  */
-
-ffebld
-ffebld_new_none (ffebldOp o)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = o;
-  return x;
-}
-
-/* ffebld_new_one -- Create an ffebld object with one argument
-
-   ffebld x,y;
-   x = ffebld_new_one(FFEBLD_opWHATEVER,y);  */
-
-ffebld
-ffebld_new_one (ffebldOp o, ffebld left)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = o;
-  x->u.nonter.left = left;
-  x->u.nonter.hook = FFECOM_nonterNULL;
-  return x;
-}
-
-/* ffebld_new_symter -- Create an ffebld object that is a symbol
-
-   ffebld x;
-   ffesymbol s;
-   ffeintrinGen gen;	// Generic intrinsic id, if any
-   ffeintrinSpec spec;	// Specific intrinsic id, if any
-   ffeintrinImp imp;	// Implementation intrinsic id, if any
-   x = ffebld_new_symter (s, gen, spec, imp);  */
-
-ffebld
-ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
-		   ffeintrinImp imp)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = FFEBLD_opSYMTER;
-  x->u.symter.symbol = s;
-  x->u.symter.generic = gen;
-  x->u.symter.specific = spec;
-  x->u.symter.implementation = imp;
-  x->u.symter.do_iter = FALSE;
-  return x;
-}
-
-/* ffebld_new_two -- Create an ffebld object with two arguments
-
-   ffebld x,y,z;
-   x = ffebld_new_two(FFEBLD_opWHATEVER,y,z);  */
-
-ffebld
-ffebld_new_two (ffebldOp o, ffebld left, ffebld right)
-{
-  ffebld x;
-
-  x = ffebld_new ();
-  x->op = o;
-  x->u.nonter.left = left;
-  x->u.nonter.right = right;
-  x->u.nonter.hook = FFECOM_nonterNULL;
-  return x;
-}
-
-/* ffebld_pool_pop -- Pop ffebld's pool stack
-
-   ffebld_pool_pop();  */
-
-void
-ffebld_pool_pop (void)
-{
-  ffebldPoolstack_ ps;
-
-  assert (ffebld_pool_stack_.next != NULL);
-  ps = ffebld_pool_stack_.next;
-  ffebld_pool_stack_.next = ps->next;
-  ffebld_pool_stack_.pool = ps->pool;
-  malloc_kill_ks (malloc_pool_image (), ps, sizeof (*ps));
-}
-
-/* ffebld_pool_push -- Push ffebld's pool stack
-
-   ffebld_pool_push();	*/
-
-void
-ffebld_pool_push (mallocPool pool)
-{
-  ffebldPoolstack_ ps;
-
-  ps = malloc_new_ks (malloc_pool_image (), "Pool stack", sizeof (*ps));
-  ps->next = ffebld_pool_stack_.next;
-  ps->pool = ffebld_pool_stack_.pool;
-  ffebld_pool_stack_.next = ps;
-  ffebld_pool_stack_.pool = pool;
-}
-
-/* ffebld_op_string -- Return short string describing op
-
-   ffebldOp o;
-   ffebld_op_string(o);
-
-   Returns a short string (uppercase) containing the name of the op.  */
-
-const char *
-ffebld_op_string (ffebldOp o)
-{
-  if (o >= ARRAY_SIZE (ffebld_op_string_))
-    return "?\?\?";
-  return ffebld_op_string_[o];
-}
-
-/* ffebld_size_max -- Return maximum possible size of CHARACTER-type expr
-
-   ffetargetCharacterSize sz;
-   ffebld b;
-   sz = ffebld_size_max (b);
-
-   Like ffebld_size_known, but if that would return NONE and the expression
-   is opSUBSTR, opCONVERT, opPAREN, or opCONCATENATE, returns ffebld_size_max
-   of the subexpression(s).  */
-
-ffetargetCharacterSize
-ffebld_size_max (ffebld b)
-{
-  ffetargetCharacterSize sz;
-
-recurse:			/* :::::::::::::::::::: */
-
-  sz = ffebld_size_known (b);
-
-  if (sz != FFETARGET_charactersizeNONE)
-    return sz;
-
-  switch (ffebld_op (b))
-    {
-    case FFEBLD_opSUBSTR:
-    case FFEBLD_opCONVERT:
-    case FFEBLD_opPAREN:
-      b = ffebld_left (b);
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opCONCATENATE:
-      sz = ffebld_size_max (ffebld_left (b))
-	+ ffebld_size_max (ffebld_right (b));
-      return sz;
-
-    default:
-      return sz;
-    }
-}
diff --git a/gcc/f/bld.h b/gcc/f/bld.h
deleted file mode 100644
index a726dec..0000000
--- a/gcc/f/bld.h
+++ /dev/null
@@ -1,748 +0,0 @@
-/* bld.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      bld.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_BLD_H
-#define GCC_F_BLD_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFEBLD_constNONE,
-    FFEBLD_constINTEGER1,
-    FFEBLD_constINTEGER2,
-    FFEBLD_constINTEGER3,
-    FFEBLD_constINTEGER4,
-    FFEBLD_constINTEGER5,
-    FFEBLD_constINTEGER6,
-    FFEBLD_constINTEGER7,
-    FFEBLD_constINTEGER8,
-    FFEBLD_constLOGICAL1,
-    FFEBLD_constLOGICAL2,
-    FFEBLD_constLOGICAL3,
-    FFEBLD_constLOGICAL4,
-    FFEBLD_constLOGICAL5,
-    FFEBLD_constLOGICAL6,
-    FFEBLD_constLOGICAL7,
-    FFEBLD_constLOGICAL8,
-    FFEBLD_constREAL1,
-    FFEBLD_constREAL2,
-    FFEBLD_constREAL3,
-    FFEBLD_constREAL4,
-    FFEBLD_constREAL5,
-    FFEBLD_constREAL6,
-    FFEBLD_constREAL7,
-    FFEBLD_constREAL8,
-    FFEBLD_constCOMPLEX1,
-    FFEBLD_constCOMPLEX2,
-    FFEBLD_constCOMPLEX3,
-    FFEBLD_constCOMPLEX4,
-    FFEBLD_constCOMPLEX5,
-    FFEBLD_constCOMPLEX6,
-    FFEBLD_constCOMPLEX7,
-    FFEBLD_constCOMPLEX8,
-    FFEBLD_constCHARACTER1,
-    FFEBLD_constCHARACTER2,
-    FFEBLD_constCHARACTER3,
-    FFEBLD_constCHARACTER4,
-    FFEBLD_constCHARACTER5,
-    FFEBLD_constCHARACTER6,
-    FFEBLD_constCHARACTER7,
-    FFEBLD_constCHARACTER8,
-    FFEBLD_constHOLLERITH,
-    FFEBLD_constTYPELESS_FIRST,
-    FFEBLD_constBINARY_MIL = FFEBLD_constTYPELESS_FIRST,
-    FFEBLD_constBINARY_VXT,
-    FFEBLD_constOCTAL_MIL,
-    FFEBLD_constOCTAL_VXT,
-    FFEBLD_constHEX_X_MIL,
-    FFEBLD_constHEX_X_VXT,
-    FFEBLD_constHEX_Z_MIL,
-    FFEBLD_constHEX_Z_VXT,
-    FFEBLD_constTYPELESS_LAST = FFEBLD_constHEX_Z_VXT,
-    FFEBLD_const
-  } ffebldConst;
-
-typedef enum
-  {
-#define FFEBLD_OP(KWD,NAME,ARITY) KWD,
-#include "bld-op.def"
-#undef FFEBLD_OP
-    FFEBLD_op
-  } ffebldOp;
-
-/* Typedefs. */
-
-typedef struct _ffebld_ *ffebld;
-typedef unsigned char ffebldArity;
-typedef union _ffebld_constant_array_ ffebldConstantArray;
-typedef struct _ffebld_constant_ *ffebldConstant;
-typedef union _ffebld_constant_union_ ffebldConstantUnion;
-typedef ffebld *ffebldListBottom;
-typedef unsigned int ffebldListLength;
-#define ffebldListLength_f ""
-typedef struct _ffebld_pool_stack_ *ffebldPoolstack_;
-
-/* Include files needed by this one. */
-
-#include "bit.h"
-#include "com.h"
-#include "info.h"
-#include "intrin.h"
-#include "lab.h"
-#include "lex.h"
-#include "malloc.h"
-#include "symbol.h"
-#include "target.h"
-
-#define FFEBLD_whereconstPROGUNIT_ 1
-#define FFEBLD_whereconstFILE_ 2
-
-#define FFEBLD_whereconstCURRENT_ FFEBLD_whereconstFILE_
-
-/* Structure definitions. */
-
-#define FFEBLD_constINTEGERDEFAULT FFEBLD_constINTEGER1
-#define FFEBLD_constLOGICALDEFAULT FFEBLD_constLOGICAL1
-#define FFEBLD_constREALDEFAULT FFEBLD_constREAL1
-#define FFEBLD_constREALDOUBLE FFEBLD_constREAL2
-#define FFEBLD_constREALQUAD FFEBLD_constREAL3
-#define FFEBLD_constCOMPLEX FFEBLD_constCOMPLEX1
-#define FFEBLD_constCOMPLEXDOUBLE FFEBLD_constCOMPLEX2
-#define FFEBLD_constCOMPLEXQUAD FFEBLD_constCOMPLEX3
-#define FFEBLD_constCHARACTERDEFAULT FFEBLD_constCHARACTER1
-
-union _ffebld_constant_union_
-  {
-    ffetargetTypeless typeless;
-    ffetargetHollerith hollerith;
-#if FFETARGET_okINTEGER1
-    ffetargetInteger1 integer1;
-#endif
-#if FFETARGET_okINTEGER2
-    ffetargetInteger2 integer2;
-#endif
-#if FFETARGET_okINTEGER3
-    ffetargetInteger3 integer3;
-#endif
-#if FFETARGET_okINTEGER4
-    ffetargetInteger4 integer4;
-#endif
-#if FFETARGET_okLOGICAL1
-    ffetargetLogical1 logical1;
-#endif
-#if FFETARGET_okLOGICAL2
-    ffetargetLogical2 logical2;
-#endif
-#if FFETARGET_okLOGICAL3
-    ffetargetLogical3 logical3;
-#endif
-#if FFETARGET_okLOGICAL4
-    ffetargetLogical4 logical4;
-#endif
-#if FFETARGET_okREAL1
-    ffetargetReal1 real1;
-#endif
-#if FFETARGET_okREAL2
-    ffetargetReal2 real2;
-#endif
-#if FFETARGET_okREAL3
-    ffetargetReal3 real3;
-#endif
-#if FFETARGET_okCOMPLEX1
-    ffetargetComplex1 complex1;
-#endif
-#if FFETARGET_okCOMPLEX2
-    ffetargetComplex2 complex2;
-#endif
-#if FFETARGET_okCOMPLEX3
-    ffetargetComplex3 complex3;
-#endif
-#if FFETARGET_okCHARACTER1
-    ffetargetCharacter1 character1;
-#endif
-  };
-
-union _ffebld_constant_array_
-  {
-#if FFETARGET_okINTEGER1
-    ffetargetInteger1 *integer1;
-#endif
-#if FFETARGET_okINTEGER2
-    ffetargetInteger2 *integer2;
-#endif
-#if FFETARGET_okINTEGER3
-    ffetargetInteger3 *integer3;
-#endif
-#if FFETARGET_okINTEGER4
-    ffetargetInteger4 *integer4;
-#endif
-#if FFETARGET_okLOGICAL1
-    ffetargetLogical1 *logical1;
-#endif
-#if FFETARGET_okLOGICAL2
-    ffetargetLogical2 *logical2;
-#endif
-#if FFETARGET_okLOGICAL3
-    ffetargetLogical3 *logical3;
-#endif
-#if FFETARGET_okLOGICAL4
-    ffetargetLogical4 *logical4;
-#endif
-#if FFETARGET_okREAL1
-    ffetargetReal1 *real1;
-#endif
-#if FFETARGET_okREAL2
-    ffetargetReal2 *real2;
-#endif
-#if FFETARGET_okREAL3
-    ffetargetReal3 *real3;
-#endif
-#if FFETARGET_okCOMPLEX1
-    ffetargetComplex1 *complex1;
-#endif
-#if FFETARGET_okCOMPLEX2
-    ffetargetComplex2 *complex2;
-#endif
-#if FFETARGET_okCOMPLEX3
-    ffetargetComplex3 *complex3;
-#endif
-#if FFETARGET_okCHARACTER1
-    ffetargetCharacterUnit1 *character1;
-#endif
-  };
-
-struct _ffebld_
-  {
-    ffebldOp op;
-    ffeinfo info;		/* Not used or valid for
-				   op=={STAR,ITEM,BOUNDS,REPEAT,LABTER,
-				   LABTOK,IMPDO}. */
-    union
-      {
-	struct
-	  {
-	    ffebld left;
-	    ffebld right;
-	    ffecomNonter hook;	/* Whatever the compiler/backend wants! */
-	  }
-	nonter;
-	struct
-	  {
-	    ffebld head;
-	    ffebld trail;
-	  }
-	item;
-	struct
-	  {
-	    ffebldConstant expr;
-	    ffebld orig;	/* Original expression, or NULL if none. */
-	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
-	  }
-	conter;
-	struct
-	  {
-	    ffebldConstantArray array;
-	    ffetargetOffset size;
-	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
-	  }
-	arrter;
-	struct
-	  {
-	    ffebldConstantArray array;
-	    ffebit bits;
-	    ffetargetAlign pad;	/* Initial padding (for DATA, etc.). */
-	  }
-	accter;
-	struct
-	  {
-	    ffesymbol symbol;
-	    ffeintrinGen generic;	/* Id for generic intrinsic. */
-	    ffeintrinSpec specific;	/* Id for specific intrinsic. */
-	    ffeintrinImp implementation;	/* Id for implementation. */
-	    bool do_iter;	/* TRUE if this ref is a read-only ref by
-				   definition (ref within DO loop using this
-				   var as iterator). */
-	  }
-	symter;
-	ffelab labter;
-	ffelexToken labtok;
-      }
-    u;
-  };
-
-struct _ffebld_constant_
-  {
-    ffebldConstant next;
-    ffebldConstant first_complex;	/* First complex const with me as
-					   real. */
-    ffebldConstant negated;	/* We point to each other through here. */
-    ffebldConst consttype;
-    ffecomConstant hook;	/* Whatever the compiler/backend wants! */
-    bool numeric;		/* A numeric kind of constant. */
-    ffebldConstantUnion u;
-  };
-
-struct _ffebld_pool_stack_
-  {
-    ffebldPoolstack_ next;
-    mallocPool pool;
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern const ffebldArity ffebld_arity_op_[(int) FFEBLD_op];
-extern struct _ffebld_pool_stack_ ffebld_pool_stack_;
-
-/* Declare functions with prototypes. */
-
-int ffebld_constant_cmp (ffebldConstant c1, ffebldConstant c2);
-bool ffebld_constant_is_magical (ffebldConstant c);
-bool ffebld_constant_is_zero (ffebldConstant c);
-#if FFETARGET_okCHARACTER1
-ffebldConstant ffebld_constant_new_character1 (ffelexToken t);
-ffebldConstant ffebld_constant_new_character1_val (ffetargetCharacter1 val);
-#endif
-#if FFETARGET_okCOMPLEX1
-ffebldConstant ffebld_constant_new_complex1 (ffebldConstant real,
-					     ffebldConstant imaginary);
-ffebldConstant ffebld_constant_new_complex1_val (ffetargetComplex1 val);
-#endif
-#if FFETARGET_okCOMPLEX2
-ffebldConstant ffebld_constant_new_complex2 (ffebldConstant real,
-					     ffebldConstant imaginary);
-ffebldConstant ffebld_constant_new_complex2_val (ffetargetComplex2 val);
-#endif
-#if FFETARGET_okCOMPLEX3
-ffebldConstant ffebld_constant_new_complex3 (ffebldConstant real,
-					     ffebldConstant imaginary);
-ffebldConstant ffebld_constant_new_complex3_val (ffetargetComplex3 val);
-#endif
-ffebldConstant ffebld_constant_new_hollerith (ffelexToken t);
-ffebldConstant ffebld_constant_new_hollerith_val (ffetargetHollerith val);
-#if FFETARGET_okINTEGER1
-ffebldConstant ffebld_constant_new_integer1 (ffelexToken t);
-ffebldConstant ffebld_constant_new_integer1_val (ffetargetInteger1 val);
-#endif
-#if FFETARGET_okINTEGER2
-ffebldConstant ffebld_constant_new_integer2 (ffelexToken t);
-ffebldConstant ffebld_constant_new_integer2_val (ffetargetInteger2 val);
-#endif
-#if FFETARGET_okINTEGER3
-ffebldConstant ffebld_constant_new_integer3 (ffelexToken t);
-ffebldConstant ffebld_constant_new_integer3_val (ffetargetInteger3 val);
-#endif
-#if FFETARGET_okINTEGER4
-ffebldConstant ffebld_constant_new_integer4 (ffelexToken t);
-ffebldConstant ffebld_constant_new_integer4_val (ffetargetInteger4 val);
-#endif
-ffebldConstant ffebld_constant_new_integerbinary (ffelexToken t);
-ffebldConstant ffebld_constant_new_integerhex (ffelexToken t);
-ffebldConstant ffebld_constant_new_integeroctal (ffelexToken t);
-#if FFETARGET_okLOGICAL1
-ffebldConstant ffebld_constant_new_logical1 (bool truth);
-ffebldConstant ffebld_constant_new_logical1_val (ffetargetLogical1 val);
-#endif
-#if FFETARGET_okLOGICAL2
-ffebldConstant ffebld_constant_new_logical2 (bool truth);
-ffebldConstant ffebld_constant_new_logical2_val (ffetargetLogical2 val);
-#endif
-#if FFETARGET_okLOGICAL3
-ffebldConstant ffebld_constant_new_logical3 (bool truth);
-ffebldConstant ffebld_constant_new_logical3_val (ffetargetLogical3 val);
-#endif
-#if FFETARGET_okLOGICAL4
-ffebldConstant ffebld_constant_new_logical4 (bool truth);
-ffebldConstant ffebld_constant_new_logical4_val (ffetargetLogical4 val);
-#endif
-#if FFETARGET_okREAL1
-ffebldConstant ffebld_constant_new_real1 (ffelexToken integer,
-	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
-		    ffelexToken exponent_sign, ffelexToken exponent_digits);
-ffebldConstant ffebld_constant_new_real1_val (ffetargetReal1 val);
-#endif
-#if FFETARGET_okREAL2
-ffebldConstant ffebld_constant_new_real2 (ffelexToken integer,
-	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
-		    ffelexToken exponent_sign, ffelexToken exponent_digits);
-ffebldConstant ffebld_constant_new_real2_val (ffetargetReal2 val);
-#endif
-#if FFETARGET_okREAL3
-ffebldConstant ffebld_constant_new_real3 (ffelexToken integer,
-	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
-		    ffelexToken exponent_sign, ffelexToken exponent_digits);
-ffebldConstant ffebld_constant_new_real3_val (ffetargetReal3 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);
-ffebldConstant ffebld_constant_new_typeless_hxv (ffelexToken t);
-ffebldConstant ffebld_constant_new_typeless_hzm (ffelexToken t);
-ffebldConstant ffebld_constant_new_typeless_hzv (ffelexToken t);
-ffebldConstant ffebld_constant_new_typeless_om (ffelexToken t);
-ffebldConstant ffebld_constant_new_typeless_ov (ffelexToken t);
-ffebldConstant ffebld_constant_new_typeless_val (ffebldConst type,
-						 ffetargetTypeless val);
-ffebldConstant ffebld_constant_negated (ffebldConstant c);
-ffebldConstantUnion ffebld_constantarray_get (ffebldConstantArray array,
-	   ffeinfoBasictype bt, ffeinfoKindtype kt, ffetargetOffset offset);
-void ffebld_constantarray_kill (ffebldConstantArray array, ffeinfoBasictype bt,
-				ffeinfoKindtype kt, ffetargetOffset size);
-ffebldConstantArray ffebld_constantarray_new (ffeinfoBasictype bt,
-				  ffeinfoKindtype kt, ffetargetOffset size);
-void ffebld_constantarray_prepare (void **aptr, void **cptr, size_t *size,
-       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
-		      ffetargetOffset offset, ffebldConstantUnion *constant,
-				 ffeinfoBasictype cbt, ffeinfoKindtype ckt);
-void ffebld_constantarray_preparray (void **aptr, void **cptr, size_t *size,
-       ffebldConstantArray array, ffeinfoBasictype abt, ffeinfoKindtype akt,
-		   ffetargetOffset offset, ffebldConstantArray source_array,
-				 ffeinfoBasictype cbt, ffeinfoKindtype ckt);
-void ffebld_constantarray_put (ffebldConstantArray array, ffeinfoBasictype bt,
-  ffeinfoKindtype kt, ffetargetOffset offset, ffebldConstantUnion constant);
-void ffebld_init_0 (void);
-void ffebld_init_1 (void);
-void ffebld_init_2 (void);
-ffebldListLength ffebld_list_length (ffebld l);
-ffebld ffebld_new_accter (ffebldConstantArray array, ffebit b);
-ffebld ffebld_new_arrter (ffebldConstantArray array, ffetargetOffset size);
-ffebld ffebld_new_conter_with_orig (ffebldConstant c, ffebld orig);
-ffebld ffebld_new_item (ffebld head, ffebld trail);
-ffebld ffebld_new_labter (ffelab l);
-ffebld ffebld_new_labtok (ffelexToken t);
-ffebld ffebld_new_none (ffebldOp o);
-ffebld ffebld_new_symter (ffesymbol s, ffeintrinGen gen, ffeintrinSpec spec,
-			  ffeintrinImp imp);
-ffebld ffebld_new_one (ffebldOp o, ffebld left);
-ffebld ffebld_new_two (ffebldOp o, ffebld left, ffebld right);
-const char *ffebld_op_string (ffebldOp o);
-void ffebld_pool_pop (void);
-void ffebld_pool_push (mallocPool pool);
-ffetargetCharacterSize ffebld_size_max (ffebld b);
-
-/* Define macros. */
-
-#define ffebld_accter(b) ((b)->u.accter.array)
-#define ffebld_accter_bits(b) ((b)->u.accter.bits)
-#define ffebld_accter_pad(b) ((b)->u.accter.pad)
-#define ffebld_accter_set_bits(b,bt) ((b)->u.accter.bits = (bt))
-#define ffebld_accter_set_pad(b,p) ((b)->u.accter.pad = (p))
-#define ffebld_accter_size(b) ffebit_size((b)->u.accter.bits)
-#define ffebld_append_item(b,i) (**(b) = ffebld_new_item((i),NULL),	      \
-				 *(b) = &((**(b))->u.item.trail))
-#define ffebld_arity(b) ffebld_arity_op(ffebld_op(b))
-#define ffebld_arity_op(o) (ffebld_arity_op_[o])
-#define ffebld_arrter(b) ((b)->u.arrter.array)
-#define ffebld_arrter_pad(b) ((b)->u.arrter.pad)
-#define ffebld_arrter_set_pad(b,p) ((b)->u.arrter.pad = (p))
-#define ffebld_arrter_set_size(b,s) ((b)->u.arrter.size = (s))
-#define ffebld_arrter_size(b) ((b)->u.arrter.size)
-#define ffebld_basictype(b) (ffeinfo_basictype (ffebld_info ((b))))
-#if FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstPROGUNIT_
-#define ffebld_constant_pool() ffe_pool_program_unit()
-#elif FFEBLD_whereconstCURRENT_ == FFEBLD_whereconstFILE_
-#define ffebld_constant_pool() ffe_pool_file()
-#else
-#error
-#endif
-#define ffebld_constant_character1(c) ((c)->u.character1)
-#define ffebld_constant_character2(c) ((c)->u.character2)
-#define ffebld_constant_character3(c) ((c)->u.character3)
-#define ffebld_constant_character4(c) ((c)->u.character4)
-#define ffebld_constant_character5(c) ((c)->u.character5)
-#define ffebld_constant_character6(c) ((c)->u.character6)
-#define ffebld_constant_character7(c) ((c)->u.character7)
-#define ffebld_constant_character8(c) ((c)->u.character8)
-#define ffebld_constant_characterdefault ffebld_constant_character1
-#define ffebld_constant_complex1(c) ((c)->u.complex1)
-#define ffebld_constant_complex2(c) ((c)->u.complex2)
-#define ffebld_constant_complex3(c) ((c)->u.complex3)
-#define ffebld_constant_complex4(c) ((c)->u.complex4)
-#define ffebld_constant_complex5(c) ((c)->u.complex5)
-#define ffebld_constant_complex6(c) ((c)->u.complex6)
-#define ffebld_constant_complex7(c) ((c)->u.complex7)
-#define ffebld_constant_complex8(c) ((c)->u.complex8)
-#define ffebld_constant_complexdefault ffebld_constant_complex1
-#define ffebld_constant_complexdouble ffebld_constant_complex2
-#define ffebld_constant_complexquad ffebld_constant_complex3
-#define ffebld_constant_copy(c) (c)
-#define ffebld_constant_hollerith(c) ((c)->u.hollerith)
-#define ffebld_constant_hook(c) ((c)->hook)
-#define ffebld_constant_integer1(c) ((c)->u.integer1)
-#define ffebld_constant_integer2(c) ((c)->u.integer2)
-#define ffebld_constant_integer3(c) ((c)->u.integer3)
-#define ffebld_constant_integer4(c) ((c)->u.integer4)
-#define ffebld_constant_integer5(c) ((c)->u.integer5)
-#define ffebld_constant_integer6(c) ((c)->u.integer6)
-#define ffebld_constant_integer7(c) ((c)->u.integer7)
-#define ffebld_constant_integer8(c) ((c)->u.integer8)
-#define ffebld_constant_integerdefault ffebld_constant_integer1
-#define ffebld_constant_is_numeric(c) ((c)->numeric)
-#define ffebld_constant_logical1(c) ((c)->u.logical1)
-#define ffebld_constant_logical2(c) ((c)->u.logical2)
-#define ffebld_constant_logical3(c) ((c)->u.logical3)
-#define ffebld_constant_logical4(c) ((c)->u.logical4)
-#define ffebld_constant_logical5(c) ((c)->u.logical5)
-#define ffebld_constant_logical6(c) ((c)->u.logical6)
-#define ffebld_constant_logical7(c) ((c)->u.logical7)
-#define ffebld_constant_logical8(c) ((c)->u.logical8)
-#define ffebld_constant_logicaldefault ffebld_constant_logical1
-#define ffebld_constant_new_characterdefault ffebld_constant_new_character1
-#define ffebld_constant_new_characterdefault_val ffebld_constant_new_character1_val
-#define ffebld_constant_new_complexdefault ffebld_constant_new_complex1
-#define ffebld_constant_new_complexdefault_val ffebld_constant_new_complex1_val
-#define ffebld_constant_new_complexdouble ffebld_constant_new_complex2
-#define ffebld_constant_new_complexdouble_val ffebld_constant_new_complex2_val
-#define ffebld_constant_new_complexquad ffebld_constant_new_complex3
-#define ffebld_constant_new_complexquad_valffebld_constant_new_complex3_val
-#define ffebld_constant_new_integerdefault ffebld_constant_new_integer1
-#define ffebld_constant_new_integerdefault_val ffebld_constant_new_integer1_val
-#define ffebld_constant_new_logicaldefault ffebld_constant_new_logical1
-#define ffebld_constant_new_logicaldefault_val ffebld_constant_new_logical1_val
-#define ffebld_constant_new_realdefault ffebld_constant_new_real1
-#define ffebld_constant_new_realdefault_val ffebld_constant_new_real1_val
-#define ffebld_constant_new_realdouble ffebld_constant_new_real2
-#define ffebld_constant_new_realdouble_val ffebld_constant_new_real2_val
-#define ffebld_constant_new_realquad ffebld_constant_new_real3
-#define ffebld_constant_new_realquad_val ffebld_constant_new_real3_val
-#define ffebld_constant_ptr_to_union(c) (&(c)->u)
-#define ffebld_constant_real1(c) ((c)->u.real1)
-#define ffebld_constant_real2(c) ((c)->u.real2)
-#define ffebld_constant_real3(c) ((c)->u.real3)
-#define ffebld_constant_real4(c) ((c)->u.real4)
-#define ffebld_constant_real5(c) ((c)->u.real5)
-#define ffebld_constant_real6(c) ((c)->u.real6)
-#define ffebld_constant_real7(c) ((c)->u.real7)
-#define ffebld_constant_real8(c) ((c)->u.real8)
-#define ffebld_constant_realdefault ffebld_constant_real1
-#define ffebld_constant_realdouble ffebld_constant_real2
-#define ffebld_constant_realquad ffebld_constant_real3
-#define ffebld_constant_set_hook(c,h) ((c)->hook = (h))
-#define ffebld_constant_set_union(c,un) ((c)->u = (un))
-#define ffebld_constant_type(c) ((c)->consttype)
-#define ffebld_constant_typeless(c) ((c)->u.typeless)
-#define ffebld_constant_union(c) ((c)->u)
-#define ffebld_conter(b) ((b)->u.conter.expr)
-#define ffebld_conter_orig(b) ((b)->u.conter.orig)
-#define ffebld_conter_pad(b) ((b)->u.conter.pad)
-#define ffebld_conter_set_orig(b,o) ((b)->u.conter.orig = (o))
-#define ffebld_conter_set_pad(b,p) ((b)->u.conter.pad = (p))
-#define ffebld_copy(b) (b)	/* ~~~Someday really make a copy. */
-#define ffebld_cu_ptr_typeless(u) &(u).typeless
-#define ffebld_cu_ptr_hollerith(u) &(u).hollerith
-#define ffebld_cu_ptr_integer1(u) &(u).integer1
-#define ffebld_cu_ptr_integer2(u) &(u).integer2
-#define ffebld_cu_ptr_integer3(u) &(u).integer3
-#define ffebld_cu_ptr_integer4(u) &(u).integer4
-#define ffebld_cu_ptr_integer5(u) &(u).integer5
-#define ffebld_cu_ptr_integer6(u) &(u).integer6
-#define ffebld_cu_ptr_integer7(u) &(u).integer7
-#define ffebld_cu_ptr_integer8(u) &(u).integer8
-#define ffebld_cu_ptr_integerdefault ffebld_cu_ptr_integer1
-#define ffebld_cu_ptr_logical1(u) &(u).logical1
-#define ffebld_cu_ptr_logical2(u) &(u).logical2
-#define ffebld_cu_ptr_logical3(u) &(u).logical3
-#define ffebld_cu_ptr_logical4(u) &(u).logical4
-#define ffebld_cu_ptr_logical5(u) &(u).logical5
-#define ffebld_cu_ptr_logical6(u) &(u).logical6
-#define ffebld_cu_ptr_logical7(u) &(u).logical7
-#define ffebld_cu_ptr_logical8(u) &(u).logical8
-#define ffebld_cu_ptr_logicaldefault ffebld_cu_ptr_logical1
-#define ffebld_cu_ptr_real1(u) &(u).real1
-#define ffebld_cu_ptr_real2(u) &(u).real2
-#define ffebld_cu_ptr_real3(u) &(u).real3
-#define ffebld_cu_ptr_real4(u) &(u).real4
-#define ffebld_cu_ptr_real5(u) &(u).real5
-#define ffebld_cu_ptr_real6(u) &(u).real6
-#define ffebld_cu_ptr_real7(u) &(u).real7
-#define ffebld_cu_ptr_real8(u) &(u).real8
-#define ffebld_cu_ptr_realdefault ffebld_cu_ptr_real1
-#define ffebld_cu_ptr_realdouble ffebld_cu_ptr_real2
-#define ffebld_cu_ptr_realquad ffebld_cu_ptr_real3
-#define ffebld_cu_ptr_complex1(u) &(u).complex1
-#define ffebld_cu_ptr_complex2(u) &(u).complex2
-#define ffebld_cu_ptr_complex3(u) &(u).complex3
-#define ffebld_cu_ptr_complex4(u) &(u).complex4
-#define ffebld_cu_ptr_complex5(u) &(u).complex5
-#define ffebld_cu_ptr_complex6(u) &(u).complex6
-#define ffebld_cu_ptr_complex7(u) &(u).complex7
-#define ffebld_cu_ptr_complex8(u) &(u).complex8
-#define ffebld_cu_ptr_complexdefault ffebld_cu_ptr_complex1
-#define ffebld_cu_ptr_complexdouble ffebld_cu_ptr_complex2
-#define ffebld_cu_ptr_complexquad ffebld_cu_ptr_complex3
-#define ffebld_cu_ptr_character1(u) &(u).character1
-#define ffebld_cu_ptr_character2(u) &(u).character2
-#define ffebld_cu_ptr_character3(u) &(u).character3
-#define ffebld_cu_ptr_character4(u) &(u).character4
-#define ffebld_cu_ptr_character5(u) &(u).character5
-#define ffebld_cu_ptr_character6(u) &(u).character6
-#define ffebld_cu_ptr_character7(u) &(u).character7
-#define ffebld_cu_ptr_character8(u) &(u).character8
-#define ffebld_cu_val_typeless(u) (u).typeless
-#define ffebld_cu_val_hollerith(u) (u).hollerith
-#define ffebld_cu_val_integer1(u) (u).integer1
-#define ffebld_cu_val_integer2(u) (u).integer2
-#define ffebld_cu_val_integer3(u) (u).integer3
-#define ffebld_cu_val_integer4(u) (u).integer4
-#define ffebld_cu_val_integer5(u) (u).integer5
-#define ffebld_cu_val_integer6(u) (u).integer6
-#define ffebld_cu_val_integer7(u) (u).integer7
-#define ffebld_cu_val_integer8(u) (u).integer8
-#define ffebld_cu_val_integerdefault ffebld_cu_val_integer1
-#define ffebld_cu_val_logical1(u) (u).logical1
-#define ffebld_cu_val_logical2(u) (u).logical2
-#define ffebld_cu_val_logical3(u) (u).logical3
-#define ffebld_cu_val_logical4(u) (u).logical4
-#define ffebld_cu_val_logical5(u) (u).logical5
-#define ffebld_cu_val_logical6(u) (u).logical6
-#define ffebld_cu_val_logical7(u) (u).logical7
-#define ffebld_cu_val_logical8(u) (u).logical8
-#define ffebld_cu_val_logicaldefault ffebld_cu_val_logical
-#define ffebld_cu_val_real1(u) (u).real1
-#define ffebld_cu_val_real2(u) (u).real2
-#define ffebld_cu_val_real3(u) (u).real3
-#define ffebld_cu_val_real4(u) (u).real4
-#define ffebld_cu_val_real5(u) (u).real5
-#define ffebld_cu_val_real6(u) (u).real6
-#define ffebld_cu_val_real7(u) (u).real7
-#define ffebld_cu_val_real8(u) (u).real8
-#define ffebld_cu_val_realdefault ffebld_cu_val_real1
-#define ffebld_cu_val_realdouble ffebld_cu_val_real2
-#define ffebld_cu_val_realquad ffebld_cu_val_real3
-#define ffebld_cu_val_complex1(u) (u).complex1
-#define ffebld_cu_val_complex2(u) (u).complex2
-#define ffebld_cu_val_complex3(u) (u).complex3
-#define ffebld_cu_val_complex4(u) (u).complex4
-#define ffebld_cu_val_complex5(u) (u).complex5
-#define ffebld_cu_val_complex6(u) (u).complex6
-#define ffebld_cu_val_complex7(u) (u).complex7
-#define ffebld_cu_val_complex8(u) (u).complex8
-#define ffebld_cu_val_complexdefault ffebld_cu_val_complex1
-#define ffebld_cu_val_complexdouble ffebld_cu_val_complex2
-#define ffebld_cu_val_complexquad ffebld_cu_val_complex3
-#define ffebld_cu_val_character1(u) (u).character1
-#define ffebld_cu_val_character2(u) (u).character2
-#define ffebld_cu_val_character3(u) (u).character3
-#define ffebld_cu_val_character4(u) (u).character4
-#define ffebld_cu_val_character5(u) (u).character5
-#define ffebld_cu_val_character6(u) (u).character6
-#define ffebld_cu_val_character7(u) (u).character7
-#define ffebld_cu_val_character8(u) (u).character8
-#define ffebld_end_list(b) (*(b) = NULL)
-#define ffebld_head(b) ((b)->u.item.head)
-#define ffebld_info(b) ((b)->info)
-#define ffebld_init_3()
-#define ffebld_init_4()
-#define ffebld_init_list(l,b) (*(l) = NULL, *(b) = (l))
-#define ffebld_item_hook(b) ((b)->u.item.hook)
-#define ffebld_item_set_hook(b,h) ((b)->u.item.hook = (h))
-#define ffebld_kind(b) (ffeinfo_kind (ffebld_info ((b))))
-#define ffebld_kindtype(b) (ffeinfo_kindtype (ffebld_info ((b))))
-#define ffebld_labter(b) ((b)->u.labter)
-#define ffebld_labtok(b) ((b)->u.labtok)
-#define ffebld_left(b) ((b)->u.nonter.left)
-#define ffebld_name_string(n) ((n)->name)
-#define ffebld_new()							      \
-  ((ffebld) malloc_new_kp(ffebld_pool(), "FFEBLD",sizeof(struct _ffebld_)))
-#define ffebld_new_any() ffebld_new_none(FFEBLD_opANY)
-#define ffebld_new_conter(c) ffebld_new_conter_with_orig((c),NULL)
-#define ffebld_new_star() ffebld_new_none(FFEBLD_opSTAR)
-#define ffebld_new_uplus(l) ffebld_new_one(FFEBLD_opUPLUS,(l))
-#define ffebld_new_uminus(l) ffebld_new_one(FFEBLD_opUMINUS,(l))
-#define ffebld_new_add(l,r) ffebld_new_two(FFEBLD_opADD,(l),(r))
-#define ffebld_new_subtract(l,r) ffebld_new_two(FFEBLD_opSUBTRACT,(l),(r))
-#define ffebld_new_multiply(l,r) ffebld_new_two(FFEBLD_opMULTIPLY,(l),(r))
-#define ffebld_new_divide(l,r) ffebld_new_two(FFEBLD_opDIVIDE,(l),(r))
-#define ffebld_new_power(l,r) ffebld_new_two(FFEBLD_opPOWER,(l),(r))
-#define ffebld_new_bounds(l,r) ffebld_new_two(FFEBLD_opBOUNDS,(l),(r))
-#define ffebld_new_concatenate(l,r) ffebld_new_two(FFEBLD_opCONCATENATE,(l),(r))
-#define ffebld_new_not(l) ffebld_new_one(FFEBLD_opNOT,(l))
-#define ffebld_new_lt(l,r) ffebld_new_two(FFEBLD_opLT,(l),(r))
-#define ffebld_new_le(l,r) ffebld_new_two(FFEBLD_opLE,(l),(r))
-#define ffebld_new_eq(l,r) ffebld_new_two(FFEBLD_opEQ,(l),(r))
-#define ffebld_new_ne(l,r) ffebld_new_two(FFEBLD_opNE,(l),(r))
-#define ffebld_new_gt(l,r) ffebld_new_two(FFEBLD_opGT,(l),(r))
-#define ffebld_new_ge(l,r) ffebld_new_two(FFEBLD_opGE,(l),(r))
-#define ffebld_new_and(l,r) ffebld_new_two(FFEBLD_opAND,(l),(r))
-#define ffebld_new_or(l,r) ffebld_new_two(FFEBLD_opOR,(l),(r))
-#define ffebld_new_xor(l,r) ffebld_new_two(FFEBLD_opXOR,(l),(r))
-#define ffebld_new_eqv(l,r) ffebld_new_two(FFEBLD_opEQV,(l),(r))
-#define ffebld_new_neqv(l,r) ffebld_new_two(FFEBLD_opNEQV,(l),(r))
-#define ffebld_new_paren(l) ffebld_new_one(FFEBLD_opPAREN,(l))
-#define ffebld_new_repeat(l,r) ffebld_new_two(FFEBLD_opREPEAT,(l),(r))
-#define ffebld_new_percent_descr(l) ffebld_new_one(FFEBLD_opPERCENT_DESCR,(l))
-#define ffebld_new_percent_loc(l) ffebld_new_one(FFEBLD_opPERCENT_LOC,(l))
-#define ffebld_new_percent_ref(l) ffebld_new_one(FFEBLD_opPERCENT_REF,(l))
-#define ffebld_new_percent_val(l) ffebld_new_one(FFEBLD_opPERCENT_VAL,(l))
-#define ffebld_new_complex(l,r) ffebld_new_two(FFEBLD_opCOMPLEX,(l),(r))
-#define ffebld_new_convert(l) ffebld_new_one(FFEBLD_opCONVERT,(l))
-#define ffebld_new_funcref(l,r) ffebld_new_two(FFEBLD_opFUNCREF,(l),(r))
-#define ffebld_new_subrref(l,r) ffebld_new_two(FFEBLD_opSUBRREF,(l),(r))
-#define ffebld_new_arrayref(l,r) ffebld_new_two(FFEBLD_opARRAYREF,(l),(r))
-#define ffebld_new_substr(l,r) ffebld_new_two(FFEBLD_opSUBSTR,(l),(r))
-#define ffebld_new_impdo(l,r) ffebld_new_two(FFEBLD_opIMPDO,(l),(r))
-#define ffebld_nonter_hook(b) ((b)->u.nonter.hook)
-#define ffebld_nonter_set_hook(b,h) ((b)->u.nonter.hook = (h))
-#define ffebld_op(b) ((b)->op)
-#define ffebld_pool() (ffebld_pool_stack_.pool)
-#define ffebld_rank(b) (ffeinfo_rank (ffebld_info ((b))))
-#define ffebld_right(b) ((b)->u.nonter.right)
-#define ffebld_set_accter(b,a) ((b)->u.accter.array = (a))
-#define ffebld_set_arrter(b,a) ((b)->u.arrter.array = (a))
-#define ffebld_set_conter(b,c) ((b)->u.conter.expr = (c))
-#define ffebld_set_info(b,i) ((b)->info = (i))
-#define ffebld_set_labter(b,l) ((b)->u.labter = (l))
-#define ffebld_set_op(b,o) ((b)->op = (o))
-#define ffebld_set_head(b,h) ((b)->u.item.head = (h))
-#define ffebld_set_left(b,l) ((b)->u.nonter.left = (l))
-#define ffebld_set_right(b,r) ((b)->u.nonter.right = (r))
-#define ffebld_set_trail(b,t) ((b)->u.item.trail = (t))
-#define ffebld_size(b) (ffeinfo_size (ffebld_info ((b))))
-#define ffebld_size_known(b) ffebld_size((b))
-#define ffebld_symter(b) ((b)->u.symter.symbol)
-#define ffebld_symter_generic(b) ((b)->u.symter.generic)
-#define ffebld_symter_doiter(b) ((b)->u.symter.do_iter)
-#define ffebld_symter_implementation(b) ((b)->u.symter.implementation)
-#define ffebld_symter_specific(b) ((b)->u.symter.specific)
-#define ffebld_symter_set_generic(b,g) ((b)->u.symter.generic = (g))
-#define ffebld_symter_set_implementation(b,i) \
-  ((b)->u.symter.implementation = (i))
-#define ffebld_symter_set_is_doiter(b,f) ((b)->u.symter.do_iter = (f))
-#define ffebld_symter_set_specific(b,s) ((b)->u.symter.specific = (s))
-#define ffebld_terminate_0()
-#define ffebld_terminate_1()
-#define ffebld_terminate_2()
-#define ffebld_terminate_3()
-#define ffebld_terminate_4()
-#define ffebld_trail(b) ((b)->u.item.trail)
-#define ffebld_where(b) (ffeinfo_where (ffebld_info ((b))))
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_BLD_H */
diff --git a/gcc/f/bugs.texi b/gcc/f/bugs.texi
deleted file mode 100644
index 176072c..0000000
--- a/gcc/f/bugs.texi
+++ /dev/null
@@ -1,267 +0,0 @@
-@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
-@c This is part of the G77 manual.
-@c For copying conditions, see the file g77.texi.
-
-@c The text of this file appears in the file BUGS
-@c in the G77 distribution, as well as in the G77 manual.
-
-@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 last-update-bugs 2002-02-01
-
-@ifset DOC-BUGS
-@include root.texi
-@c The immediately following lines apply to the BUGS file
-@c which is derived from this file.
-@emph{Note:} This file is automatically generated from the files
-@file{bugs0.texi} and @file{bugs.texi}.
-@file{BUGS} is @emph{not} a source file,
-although it is normally included within source distributions.
-
-This file lists known bugs in the @value{which-g77} version
-of the GNU Fortran compiler.
-Copyright (C) @value{copyrights-bugs} Free Software Foundation, Inc.
-You may copy, distribute, and modify it freely as long as you preserve
-this copyright notice and permission notice.
-
-@node Top,,, (dir)
-@chapter Known Bugs In GNU Fortran
-@end ifset
-
-@ifset DOC-G77
-@node Known Bugs
-@section Known Bugs In GNU Fortran
-@end ifset
-
-This section identifies bugs that @code{g77} @emph{users}
-might run into in the @value{which-g77} version
-of @code{g77}.
-This includes bugs that are actually in the @code{gcc}
-back end (GBE) or in @code{libf2c}, because those
-sets of code are at least somewhat under the control
-of (and necessarily intertwined with) @code{g77},
-so it isn't worth separating them out.
-
-@ifset DOC-G77
-For information on bugs in @emph{other} versions of @code{g77},
-see @ref{News,,News About GNU Fortran}.
-There, lists of bugs fixed in various versions of @code{g77}
-can help determine what bugs existed in prior versions.
-@end ifset
-
-@ifset DOC-BUGS
-For information on bugs in @emph{other} versions of @code{g77},
-see @file{@value{path-g77}/NEWS}.
-There, lists of bugs fixed in various versions of @code{g77}
-can help determine what bugs existed in prior versions.
-@end ifset
-
-@ifset DEVELOPMENT
-@emph{Warning:} The information below is still under development,
-and might not accurately reflect the @code{g77} code base
-of which it is a part.
-Efforts are made to keep it somewhat up-to-date,
-but they are particularly concentrated
-on any version of this information
-that is distributed as part of a @emph{released} @code{g77}.
-
-In particular, while this information is intended to apply to
-the @value{which-g77} version of @code{g77},
-only an official @emph{release} of that version
-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
-@item
-@code{g77} fails to warn about
-use of a ``live'' iterative-DO variable
-as an implied-DO variable
-in a @code{WRITE} or @code{PRINT} statement
-(although it does warn about this in a @code{READ} statement).
-
-@item
-Something about @code{g77}'s straightforward handling of
-label references and definitions sometimes prevents the GBE
-from unrolling loops.
-Until this is solved, try inserting or removing @code{CONTINUE}
-statements as the terminal statement, using the @code{END DO}
-form instead, and so on.
-
-@item
-Some confusion in diagnostics concerning failing @code{INCLUDE}
-statements from within @code{INCLUDE}'d or @code{#include}'d files.
-
-@cindex integer constants
-@cindex constants, integer
-@item
-@code{g77} assumes that @code{INTEGER(KIND=1)} constants range
-from @samp{-2**31} to @samp{2**31-1} (the range for
-two's-complement 32-bit values),
-instead of determining their range from the actual range of the
-type for the configuration (and, someday, for the constant).
-
-Further, it generally doesn't implement the handling
-of constants very well in that it makes assumptions about the
-configuration that it no longer makes regarding variables (types).
-
-Included with this item is the fact that @code{g77} doesn't recognize
-that, on IEEE-754/854-compliant systems, @samp{0./0.} should produce a NaN
-and no warning instead of the value @samp{0.} and a warning.
-
-@cindex compiler speed
-@cindex speed, of compiler
-@cindex compiler memory usage
-@cindex memory usage, of compiler
-@cindex large aggregate areas
-@cindex initialization, bug
-@cindex DATA statement
-@cindex statements, DATA
-@item
-@code{g77} uses way too much memory and CPU time to process large aggregate
-areas having any initialized elements.
-
-For example, @samp{REAL A(1000000)} followed by @samp{DATA A(1)/1/}
-takes up way too much time and space, including
-the size of the generated assembler file.
-
-Version 0.5.18 improves cases like this---specifically,
-cases of @emph{sparse} initialization that leave large, contiguous
-areas uninitialized---significantly.
-However, even with the improvements, these cases still
-require too much memory and CPU time.
-
-(Version 0.5.18 also improves cases where the initial values are
-zero to a much greater degree, so if the above example
-ends with @samp{DATA A(1)/0/}, the compile-time performance
-will be about as good as it will ever get, aside from unrelated
-improvements to the compiler.)
-
-Note that @code{g77} does display a warning message to
-notify the user before the compiler appears to hang.
-@ifset DOC-G77
-A warning message is issued when @code{g77} sees code that provides
-initial values (e.g. via @code{DATA}) to an aggregate area (@code{COMMON}
-or @code{EQUIVALENCE}, or even a large enough array or @code{CHARACTER}
-variable)
-that is large enough to increase @code{g77}'s compile time by roughly
-a factor of 10.
-
-This size currently is quite small, since @code{g77}
-currently has a known bug requiring too much memory
-and time to handle such cases.
-In @file{@value{path-g77}/data.c}, the macro
-@code{FFEDATA_sizeTOO_BIG_INIT_} is defined
-to the minimum size for the warning to appear.
-The size is specified in storage units,
-which can be bytes, words, or whatever, on a case-by-case basis.
-
-After changing this macro definition, you must
-(of course) rebuild and reinstall @code{g77} for
-the change to take effect.
-
-Note that, as of version 0.5.18, improvements have
-reduced the scope of the problem for @emph{sparse}
-initialization of large arrays, especially those
-with large, contiguous uninitialized areas.
-However, the warning is issued at a point prior to
-when @code{g77} knows whether the initialization is sparse,
-and delaying the warning could mean it is produced
-too late to be helpful.
-
-Therefore, the macro definition should not be adjusted to
-reflect sparse cases.
-Instead, adjust it to generate the warning when densely
-initialized arrays begin to cause responses noticeably slower
-than linear performance would suggest.
-@end ifset
-
-@cindex code, displaying main source
-@cindex displaying main source code
-@cindex debugging main source code
-@cindex printing main source
-@item
-When debugging, after starting up the debugger but before being able
-to see the source code for the main program unit, the user must currently
-set a breakpoint at @code{MAIN__} (or @code{MAIN___} or @code{MAIN_} if
-@code{MAIN__} doesn't exist)
-and run the program until it hits the breakpoint.
-At that point, the
-main program unit is activated and about to execute its first
-executable statement, but that's the state in which the debugger should
-start up, as is the case for languages like C.
-
-@cindex debugger
-@item
-Debugging @code{g77}-compiled code using debuggers other than
-@code{gdb} is likely not to work.
-
-Getting @code{g77} and @code{gdb} to work together is a known
-problem---getting @code{g77} to work properly with other
-debuggers, for which source code often is unavailable to @code{g77}
-developers, seems like a much larger, unknown problem,
-and is a lower priority than making @code{g77} and @code{gdb}
-work together properly.
-
-On the other hand, information about problems other debuggers
-have with @code{g77} output might make it easier to properly
-fix @code{g77}, and perhaps even improve @code{gdb}, so it
-is definitely welcome.
-Such information might even lead to all relevant products
-working together properly sooner.
-
-@cindex Alpha, support
-@cindex support, Alpha
-@item
-@code{g77} doesn't work perfectly on 64-bit configurations
-such as the Digital Semiconductor (``DEC'') Alpha.
-
-This problem is largely resolved as of version 0.5.23.
-
-@cindex padding
-@cindex structures
-@cindex common blocks
-@cindex equivalence areas
-@item
-@code{g77} currently inserts needless padding for things like
-@samp{COMMON A,IPAD} where @samp{A} is @code{CHARACTER*1} and @samp{IPAD}
-is @code{INTEGER(KIND=1)} on machines like x86,
-because the back end insists that @samp{IPAD}
-be aligned to a 4-byte boundary,
-but the processor has no such requirement
-(though it is usually good for performance).
-
-The @code{gcc} back end needs to provide a wider array
-of specifications of alignment requirements and preferences for targets,
-and front ends like @code{g77} should take advantage of this
-when it becomes available.
-
-@cindex complex performance
-@cindex aliasing
-@item
-The @code{libf2c} routines that perform some run-time
-arithmetic on @code{COMPLEX} operands
-were modified circa version 0.5.20 of @code{g77}
-to work properly even in the presence of aliased operands.
-
-While the @code{g77} and @code{netlib} versions of @code{libf2c}
-differ on how this is accomplished,
-the main differences are that we believe
-the @code{g77} version works properly
-even in the presence of @emph{partially} aliased operands.
-
-However, these modifications have reduced performance
-on targets such as x86,
-due to the extra copies of operands involved.
-@end itemize
diff --git a/gcc/f/bugs0.texi b/gcc/f/bugs0.texi
deleted file mode 100644
index 9636f4d..0000000
--- a/gcc/f/bugs0.texi
+++ /dev/null
@@ -1,9 +0,0 @@
-\input texinfo  @c -*-texinfo-*-
-@c %**start of header
-@setfilename BUGS
-@c %**end of header
-
-@c This tells bugs.texi that it's generating just the BUGS file.
-@set DOC-BUGS
-@include bugs.texi
-@bye
diff --git a/gcc/f/com-rt.def b/gcc/f/com-rt.def
deleted file mode 100644
index 185aef5..0000000
--- a/gcc/f/com-rt.def
+++ /dev/null
@@ -1,289 +0,0 @@
-/* com-rt.def -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      com.c
-
-   Modifications:
-*/
-
-/* DEFGFRT(CODE,NAME,TYPE,VOLATILE,COMPLEX,CONST):
-
-   CODE -- the #define name to use to refer to the function in g77 code
-
-   NAME -- the name as seen by the back end and, with whatever massaging
-	   is normal, the linker
-
-   TYPE -- a code for the tree for the type, assigned when first encountered
-	   (NOTE: There's a distinction made between the semantic return
-	   value for the function, and the actual return mechanism; e.g.
-	   `r_abs()' computes a single-precision `float' return value
-	   but returns it as a `double'.  This distinction is important
-	   and is flagged via the _F2C_ versus _GNU_ suffix.)
-
-   ARGS -- a string of codes representing the types of the arguments; the
-           last type specifies the type for that and all following args,
-           and the null pointer (0) means the same as "0":
-
-               0  Not applicable at and beyond this point
-               &  Pointer to type that follows
-               a  char
-               c  complex
-               d  doublereal
-               e  doublecomplex
-               f  real
-               i  integer
-               j  longint
-
-   VOLATILE -- TRUE if the function never returns (gen's emit_barrier in
-	       g77 back end)
-
-   COMPLEX -- TRUE if the return value is COMPLEX or DOUBLE COMPLEX and
-	      thus might need to be returned as ptr-to-1st-arg
-
-   CONST -- TRUE if the function is const
-            (does not have side effects and only depends on its arguments).
-
-*/
-
-DEFGFRT (FFECOM_gfrtCAT, "s_cat", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCMP, "s_cmp", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCOPY, "s_copy", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPAUSE, "s_paus", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSTOP, "s_stop", FFECOM_rttypeVOID_, 0, TRUE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtRANGE, "s_rnge", FFECOM_rttypeINTEGER_, 0, TRUE, FALSE, FALSE)
-
-DEFGFRT (FFECOM_gfrtSRDUE, "s_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERDUE, "e_rdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRSUE, "s_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERSUE, "e_rsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRDFE, "s_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERDFE, "e_rdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRSFI, "s_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERSFI, "e_rsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRSFE, "s_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERSFE, "e_rsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRSLI, "s_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERSLI, "e_rsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRSLE, "s_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERSLE, "e_rsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRSNE, "s_rsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-
-DEFGFRT (FFECOM_gfrtSWDUE, "s_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWDUE, "e_wdue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWSUE, "s_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWSUE, "e_wsue", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWDFE, "s_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWDFE, "e_wdfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWSFI, "s_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWSFI, "e_wsfi", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWSFE, "s_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWSFE, "e_wsfe", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWSLI, "s_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWSLI, "e_wsli", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWSLE, "s_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEWSLE, "e_wsle", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSWSNE, "s_wsne", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-
-DEFGFRT (FFECOM_gfrtDOFIO, "do_fio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDOLIO, "do_lio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDOUIO, "do_uio", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-
-DEFGFRT (FFECOM_gfrtFOPEN, "f_open", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFCLOS, "f_clos", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFINQU, "f_inqu", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-
-DEFGFRT (FFECOM_gfrtFBACK, "f_back", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFEND, "f_end", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFREW, "f_rew", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-
-DEFGFRT (FFECOM_gfrtABORT, "G77_abort_0", FFECOM_rttypeVOID_, 0, TRUE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtABS, "r_abs", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtACCESS, "G77_access_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtACOS, "r_acos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtAIMAG, "r_imag", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtAINT, "r_int", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtALARM, "G77_alarm_0", FFECOM_rttypeINTEGER_, "&i0", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtALOG, "r_log", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtALOG10, "r_lg10", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtAMOD, "r_mod", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-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&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)
-DEFGFRT (FFECOM_gfrtCHDIR, "G77_chdir_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCLOG, "c_log", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCHMOD, "G77_chmod_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCONJG, "r_cnjg", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCOS, "r_cos", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCOSH, "r_cosh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCSIN, "c_sin", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCSQRT, "c_sqrt", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCTIME, "G77_ctime_0", FFECOM_rttypeCHARACTER_, "&j", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDABS, "d_abs", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDACOS, "d_acos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDASIN, "d_asin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDATAN, "d_atan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDATAN2, "d_atn2", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDATE, "G77_date_y2kbug_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDATE_AND_TIME, "G77_date_and_time_0", FFECOM_rttypeVOID_, "&a&a&a&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtL_BESJ0, "j0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtL_BESJ1, "j1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtL_BESJN, "jn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtL_BESY0, "y0", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtL_BESY1, "y1", FFECOM_rttypeDOUBLE_, "d", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtL_BESYN, "yn", FFECOM_rttypeDOUBLE_, "id", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtDCOS, "d_cos", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDCOSH, "d_cosh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDDIM, "d_dim", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDERF, "G77_derf_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDERFC, "G77_derfc_0", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDEXP, "d_exp", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDIM, "r_dim", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDINT, "d_int", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDLOG, "d_log", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDLOG10, "d_lg10", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDMOD, "d_mod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDNINT, "d_nint", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDPROD, "d_prod", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDSIGN, "d_sign", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDSIN, "d_sin", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDSINH, "d_sinh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDSQRT, "d_sqrt", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDTAN, "d_tan", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDTANH, "d_tanh", FFECOM_rttypeDOUBLE_, "&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtDTIME, "G77_dtime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERF, "G77_erf_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtERFC, "G77_erfc_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtETIME, "G77_etime_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEXIT, "G77_exit_0", FFECOM_rttypeVOID_, "&i", TRUE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtEXP, "r_exp", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFDATE, "G77_fdate_0", FFECOM_rttypeCHARACTER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFGET, "G77_fget_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFGETC, "G77_fgetc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFLUSH, "G77_flush_0", FFECOM_rttypeVOID_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFLUSH1, "G77_flush1_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFNUM, "G77_fnum_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFPUT, "G77_fput_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFPUTC, "G77_fputc_0", FFECOM_rttypeINTEGER_, "&i&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFSTAT, "G77_fstat_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFTELL, "G77_ftell_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtFSEEK, "G77_fseek_0", FFECOM_rttypeINTEGER_, "&i&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGERROR, "G77_gerror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETARG, "G77_getarg_0", FFECOM_rttypeVOID_, "&i&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETCWD, "G77_getcwd_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETGID, "G77_getgid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETLOG, "G77_getlog_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETPID, "G77_getpid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETUID, "G77_getuid_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGETENV, "G77_getenv_0", FFECOM_rttypeVOID_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtGMTIME, "G77_gmtime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtHOSTNM, "G77_hostnm_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIABS, "i_abs", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIARGC, "G77_iargc_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIDATE, "G77_idate_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIDIM, "i_dim", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIDNINT, "i_dnnt", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIERRNO, "G77_ierrno_0", FFECOM_rttypeINTEGER_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtINDEX, "i_indx", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtIRAND, "G77_irand_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtISIGN, "i_sign", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtISATTY, "G77_isatty_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtITIME, "G77_itime_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtKILL, "G77_kill_0", FFECOM_rttypeINTEGER_, "&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLEN, "i_len", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, TRUE)
-DEFGFRT (FFECOM_gfrtLGE, "l_ge", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLGT, "l_gt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLINK, "G77_link_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLLE, "l_le", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLLT, "l_lt", FFECOM_rttypeLOGICAL_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLNBLNK, "G77_lnblnk_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLSTAT, "G77_lstat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtLTIME, "G77_ltime_0", FFECOM_rttypeVOID_, "&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtMCLOCK, "G77_mclock_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtMOD, "i_mod", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtNINT, "i_nint", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPERROR, "G77_perror_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtRAND, "G77_rand_0", FFECOM_rttypeREAL_F2C_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtRENAME, "G77_rename_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSECNDS, "G77_secnds_0", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSECOND, "G77_second_0", FFECOM_rttypeREAL_F2C_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSIGN, "r_sign", FFECOM_rttypeREAL_F2C_, "&f&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtL_SIGNAL, "G77_signal_0", FFECOM_rttypeVOIDSTAR_, "&i0", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSIN, "r_sin", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSINH, "r_sinh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSLEEP, "G77_sleep_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSQRT, "r_sqrt", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSRAND, "G77_srand_0", FFECOM_rttypeVOID_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSTAT, "G77_stat_0", FFECOM_rttypeINTEGER_, "&a&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSYMLNK, "G77_symlnk_0", FFECOM_rttypeINTEGER_, "&a&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSYSTEM, "G77_system_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtSYSTEM_CLOCK, "G77_system_clock_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtTAN, "r_tan", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtTANH, "r_tanh", FFECOM_rttypeREAL_F2C_, "&f", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtTIME, "G77_time_0", FFECOM_rttypeLONGINT_, 0, FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtTTYNAM, "G77_ttynam_0", FFECOM_rttypeCHARACTER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtUNLINK, "G77_unlink_0", FFECOM_rttypeINTEGER_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtUMASK, "G77_umask_0", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtVXTIDATE, "G77_vxtidate_y2kbug_0", FFECOM_rttypeVOID_, "&i&i&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtVXTTIME, "G77_vxttime_0", FFECOM_rttypeVOID_, "&a", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCDABS, "z_abs", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtCDCOS, "z_cos", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCDEXP, "z_exp", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCDLOG, "z_log", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtDCONJG, "d_cnjg", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCDSIN, "z_sin", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtCDSQRT, "z_sqrt", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtDIMAG, "d_imag", FFECOM_rttypeDOUBLE_, "&e", FALSE, FALSE, FALSE)
-
-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, "__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, "__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, "__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, "__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)
-DEFGFRT (FFECOM_gfrtPOW_DD, "pow_dd", FFECOM_rttypeDOUBLE_, "&d&d", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPOW_DI, "pow_di", FFECOM_rttypeDOUBLE_, "&d&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPOW_II, "pow_ii", FFECOM_rttypeINTEGER_, "&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPOW_QQ, "pow_qq", FFECOM_rttypeLONGINT_, "&j&j", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPOW_RI, "pow_ri", FFECOM_rttypeREAL_F2C_, "&f&i", FALSE, FALSE, FALSE)
-DEFGFRT (FFECOM_gfrtPOW_ZI, "pow_zi", FFECOM_rttypeDBLCMPLX_F2C_, "&e&i", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtPOW_ZZ, "pow_zz", FFECOM_rttypeDBLCMPLX_F2C_, "&e&e", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtDIV_CC, "c_div", FFECOM_rttypeCOMPLEX_F2C_, "&c", FALSE, TRUE, FALSE)
-DEFGFRT (FFECOM_gfrtDIV_ZZ, "z_div", FFECOM_rttypeDBLCMPLX_F2C_, "&e", FALSE, TRUE, FALSE)
diff --git a/gcc/f/com.c b/gcc/f/com.c
deleted file mode 100644
index 951e018..0000000
--- a/gcc/f/com.c
+++ /dev/null
@@ -1,16532 +0,0 @@
-/* com.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Contains compiler-specific functions.
-
-   Modifications:
-*/
-
-/* Understanding this module means understanding the interface between
-   the g77 front end and the gcc back end (or, perhaps, some other
-   back end).  In here are the functions called by the front end proper
-   to notify whatever back end is in place about certain things, and
-   also the back-end-specific functions.  It's a bear to deal with, so
-   lately I've been trying to simplify things, especially with regard
-   to the gcc-back-end-specific stuff.
-
-   Building expressions generally seems quite easy, but building decls
-   has been challenging and is undergoing revision.  gcc has several
-   kinds of decls:
-
-   TYPE_DECL -- a type (int, float, struct, function, etc.)
-   CONST_DECL -- a constant of some type other than function
-   LABEL_DECL -- a variable or a constant?
-   PARM_DECL -- an argument to a function (a variable that is a dummy)
-   RESULT_DECL -- the return value of a function (a variable)
-   VAR_DECL -- other variable (can hold a ptr-to-function, struct, int, etc.)
-   FUNCTION_DECL -- a function (either the actual function or an extern ref)
-   FIELD_DECL -- a field in a struct or union (goes into types)
-
-   g77 has a set of functions that somewhat parallels the gcc front end
-   when it comes to building decls:
-
-   Internal Function (one we define, not just declare as extern):
-   if (is_nested) push_f_function_context ();
-   start_function (get_identifier ("function_name"), function_type,
-		   is_nested, is_public);
-   // for each arg, build PARM_DECL and call push_parm_decl (decl) with it;
-   store_parm_decls (is_main_program);
-   ffecom_start_compstmt ();
-   // for stmts and decls inside function, do appropriate things;
-   ffecom_end_compstmt ();
-   finish_function (is_nested);
-   if (is_nested) pop_f_function_context ();
-
-   Everything Else:
-   tree d;
-   tree init;
-   // fill in external, public, static, &c for decl, and
-   // set DECL_INITIAL to error_mark_node if going to initialize
-   // set is_top_level TRUE only if not at top level and decl
-   // must go in top level (i.e. not within current function decl context)
-   d = start_decl (decl, is_top_level);
-   init = ...;	// if have initializer
-   finish_decl (d, init, is_top_level);
-
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "flags.h"
-#include "real.h"
-#include "rtl.h"
-#include "toplev.h"
-#include "tree.h"
-#include "output.h"  /* Must follow tree.h so TREE_CODE is defined! */
-#include "convert.h"
-#include "ggc.h"
-#include "diagnostic.h"
-#include "intl.h"
-#include "langhooks.h"
-#include "langhooks-def.h"
-#include "debug.h"
-
-/* VMS-specific definitions */
-#ifdef VMS
-#include <descrip.h>
-#define O_RDONLY	0	/* Open arg for Read/Only  */
-#define O_WRONLY	1	/* Open arg for Write/Only */
-#define read(fd,buf,size)	VMS_read (fd,buf,size)
-#define write(fd,buf,size)	VMS_write (fd,buf,size)
-#define open(fname,mode,prot)	VMS_open (fname,mode,prot)
-#define fopen(fname,mode)	VMS_fopen (fname,mode)
-#define freopen(fname,mode,ofile) VMS_freopen (fname,mode,ofile)
-#define strncat(dst,src,cnt) VMS_strncat (dst,src,cnt)
-#define fstat(fd,stbuf)		VMS_fstat (fd,stbuf)
-static int VMS_fstat (), VMS_stat ();
-static char * VMS_strncat ();
-static int VMS_read ();
-static int VMS_write ();
-static int VMS_open ();
-static FILE * VMS_fopen ();
-static FILE * VMS_freopen ();
-static void hack_vms_include_specification ();
-typedef struct { unsigned :16, :16, :16; } vms_ino_t;
-#define ino_t vms_ino_t
-#define INCLUDE_LEN_FUDGE 10	/* leave room for VMS syntax conversion */
-#endif /* VMS */
-
-#define FFECOM_DETERMINE_TYPES 1 /* for com.h */
-#include "com.h"
-#include "bad.h"
-#include "bld.h"
-#include "equiv.h"
-#include "expr.h"
-#include "implic.h"
-#include "info.h"
-#include "malloc.h"
-#include "src.h"
-#include "st.h"
-#include "storag.h"
-#include "symbol.h"
-#include "target.h"
-#include "top.h"
-#include "type.h"
-#include "function.h"
-
-/* Externals defined here.  */
-
-/* Stream for reading from the input file.  */
-FILE *finput;
-
-/* These definitions parallel those in c-decl.c so that code from that
-   module can be used pretty much as is.  Much of these defs aren't
-   otherwise used, i.e. by g77 code per se, except some of them are used
-   to build some of them that are.  The ones that are global (i.e. not
-   "static") are those that ste.c and such might use (directly
-   or by using com macros that reference them in their definitions).  */
-
-tree string_type_node;
-
-/* The rest of these are inventions for g77, though there might be
-   similar things in the C front end.  As they are found, these
-   inventions should be renamed to be canonical.  Note that only
-   the ones currently required to be global are so.  */
-
-static GTY(()) tree ffecom_tree_fun_type_void;
-
-tree ffecom_integer_type_node;	/* Abbrev for _tree_type[blah][blah]. */
-tree ffecom_integer_zero_node;	/* Like *_*_* with g77's integer type. */
-tree ffecom_integer_one_node;	/* " */
-tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
-
-/* _fun_type things are the f2c-specific versions.  For -fno-f2c,
-   just use build_function_type and build_pointer_type on the
-   appropriate _tree_type array element.  */
-
-static GTY(()) tree ffecom_tree_fun_type[FFEINFO_basictype][FFEINFO_kindtype];
-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;
-static GTY(()) tree ffecom_tree_blockdata_type;
-
-static GTY(()) tree ffecom_tree_xargc_;
-
-ffecomSymbol ffecom_symbol_null_
-=
-{
-  NULL_TREE,
-  NULL_TREE,
-  NULL_TREE,
-  NULL_TREE,
-  false
-};
-ffeinfoKindtype ffecom_pointer_kind_ = FFEINFO_basictypeNONE;
-ffeinfoKindtype ffecom_label_kind_ = FFEINFO_basictypeNONE;
-
-int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
-tree ffecom_f2c_integer_type_node;
-static GTY(()) tree ffecom_f2c_ptr_to_integer_type_node;
-tree ffecom_f2c_address_type_node;
-tree ffecom_f2c_real_type_node;
-static GTY(()) tree ffecom_f2c_ptr_to_real_type_node;
-tree ffecom_f2c_doublereal_type_node;
-tree ffecom_f2c_complex_type_node;
-tree ffecom_f2c_doublecomplex_type_node;
-tree ffecom_f2c_longint_type_node;
-tree ffecom_f2c_logical_type_node;
-tree ffecom_f2c_flag_type_node;
-tree ffecom_f2c_ftnlen_type_node;
-tree ffecom_f2c_ftnlen_zero_node;
-tree ffecom_f2c_ftnlen_one_node;
-tree ffecom_f2c_ftnlen_two_node;
-tree ffecom_f2c_ptr_to_ftnlen_type_node;
-tree ffecom_f2c_ftnint_type_node;
-tree ffecom_f2c_ptr_to_ftnint_type_node;
-
-/* Simple definitions and enumerations. */
-
-#ifndef FFECOM_sizeMAXSTACKITEM
-#define FFECOM_sizeMAXSTACKITEM 32*1024	/* Keep user-declared things
-					   larger than this # bytes
-					   off stack if possible. */
-#endif
-
-/* For systems that have large enough stacks, they should define
-   this to 0, and here, for ease of use later on, we just undefine
-   it if it is 0.  */
-
-#if FFECOM_sizeMAXSTACKITEM == 0
-#undef FFECOM_sizeMAXSTACKITEM
-#endif
-
-typedef enum
-  {
-    FFECOM_rttypeVOID_,
-    FFECOM_rttypeVOIDSTAR_,	/* C's `void *' type. */
-    FFECOM_rttypeFTNINT_,	/* f2c's `ftnint' type. */
-    FFECOM_rttypeINTEGER_,	/* f2c's `integer' type. */
-    FFECOM_rttypeLONGINT_,	/* f2c's `longint' type. */
-    FFECOM_rttypeLOGICAL_,	/* f2c's `logical' type. */
-    FFECOM_rttypeREAL_F2C_,	/* f2c's `real' returned as `double'. */
-    FFECOM_rttypeREAL_GNU_,	/* `real' returned as such. */
-    FFECOM_rttypeCOMPLEX_F2C_,	/* f2c's `complex' returned via 1st arg. */
-    FFECOM_rttypeCOMPLEX_GNU_,	/* f2c's `complex' returned directly. */
-    FFECOM_rttypeDOUBLE_,	/* C's `double' type. */
-    FFECOM_rttypeDOUBLEREAL_,	/* f2c's `doublereal' type. */
-    FFECOM_rttypeDBLCMPLX_F2C_,	/* f2c's `doublecomplex' returned via 1st arg. */
-    FFECOM_rttypeDBLCMPLX_GNU_,	/* f2c's `doublecomplex' returned directly. */
-    FFECOM_rttypeCHARACTER_,	/* f2c `char *'/`ftnlen' pair. */
-    FFECOM_rttype_
-  } ffecomRttype_;
-
-/* Internal typedefs. */
-
-typedef struct _ffecom_concat_list_ ffecomConcatList_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffecom_concat_list_
-  {
-    ffebld *exprs;
-    int count;
-    int max;
-    ffetargetCharacterSize minlen;
-    ffetargetCharacterSize maxlen;
-  };
-
-/* Static functions (internal). */
-
-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,
-			     tree dest_size, tree source_tree,
-			     ffebld source, bool scalar_arg);
-static bool ffecom_args_overlapping_ (tree dest_tree, ffebld dest,
-				      tree args, tree callee_commons,
-				      bool scalar_args);
-static tree ffecom_build_f2c_string_ (int i, const char *s);
-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);
-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);
-static void ffecom_char_args_x_ (tree *xitem, tree *length,
-				 ffebld expr, bool with_null);
-static tree ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy);
-static tree ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s);
-static ffecomConcatList_
-  ffecom_concat_list_gather_ (ffecomConcatList_ catlist,
-			      ffebld expr,
-			      ffetargetCharacterSize max);
-static void ffecom_concat_list_kill_ (ffecomConcatList_ catlist);
-static ffecomConcatList_ ffecom_concat_list_new_ (ffebld expr,
-						ffetargetCharacterSize max);
-static void ffecom_debug_kludge_ (tree aggr, const char *aggr_type,
-				  ffesymbol member, tree member_type,
-				  ffetargetOffset offset);
-static void ffecom_do_entry_ (ffesymbol fn, int entrynum);
-static tree ffecom_expr_ (ffebld expr, tree dest_tree, ffebld dest,
-			  bool *dest_used, bool assignp, bool widenp);
-static tree ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree,
-				    ffebld dest, bool *dest_used);
-static tree ffecom_expr_power_integer_ (ffebld expr);
-static void ffecom_expr_transform_ (ffebld expr);
-static void ffecom_f2c_make_type_ (tree *type, int tcode, const char *name);
-static void ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size,
-				      int code);
-static ffeglobal ffecom_finish_global_ (ffeglobal global);
-static ffesymbol ffecom_finish_symbol_transform_ (ffesymbol s);
-static tree ffecom_get_appended_identifier_ (char us, const char *text);
-static tree ffecom_get_external_identifier_ (ffesymbol s);
-static tree ffecom_get_identifier_ (const char *text);
-static tree ffecom_gen_sfuncdef_ (ffesymbol s,
-				  ffeinfoBasictype bt,
-				  ffeinfoKindtype kt);
-static const char *ffecom_gfrt_args_ (ffecomGfrt ix);
-static tree ffecom_gfrt_tree_ (ffecomGfrt ix);
-static tree ffecom_init_zero_ (tree decl);
-static tree ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg,
-				     tree *maybe_tree);
-static tree ffecom_intrinsic_len_ (ffebld expr);
-static void ffecom_let_char_ (tree dest_tree,
-			      tree dest_length,
-			      ffetargetCharacterSize dest_size,
-			      ffebld source);
-static void ffecom_make_gfrt_ (ffecomGfrt ix);
-static void ffecom_member_phase1_ (ffestorag mst, ffestorag st);
-static void ffecom_member_phase2_ (ffestorag mst, ffestorag st);
-static void ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size,
-				      ffebld source);
-static void ffecom_push_dummy_decls_ (ffebld dumlist,
-				      bool stmtfunc);
-static void ffecom_start_progunit_ (void);
-static ffesymbol ffecom_sym_transform_ (ffesymbol s);
-static ffesymbol ffecom_sym_transform_assign_ (ffesymbol s);
-static void ffecom_transform_common_ (ffesymbol s);
-static void ffecom_transform_equiv_ (ffestorag st);
-static tree ffecom_transform_namelist_ (ffesymbol s);
-static void ffecom_tree_canonize_ptr_ (tree *decl, tree *offset,
-				       tree t);
-static void ffecom_tree_canonize_ref_ (tree *decl, tree *offset,
-				       tree *size, tree tree);
-static tree ffecom_tree_divide_ (tree tree_type, tree left, tree right,
-				 tree dest_tree, ffebld dest,
-				 bool *dest_used, tree hook);
-static tree ffecom_type_localvar_ (ffesymbol s,
-				   ffeinfoBasictype bt,
-				   ffeinfoKindtype kt);
-static tree ffecom_type_namelist_ (void);
-static tree ffecom_type_vardesc_ (void);
-static tree ffecom_vardesc_ (ffebld expr);
-static tree ffecom_vardesc_array_ (ffesymbol s);
-static tree ffecom_vardesc_dims_ (ffesymbol s);
-static tree ffecom_convert_narrow_ (tree type, tree expr);
-static tree ffecom_convert_widen_ (tree type, tree expr);
-
-/* These are static functions that parallel those found in the C front
-   end and thus have the same names.  */
-
-static tree bison_rule_compstmt_ (void);
-static void bison_rule_pushlevel_ (void);
-static void delete_block (tree block);
-static int duplicate_decls (tree newdecl, tree olddecl);
-static void finish_decl (tree decl, tree init, bool is_top_level);
-static void finish_function (int nested);
-static const char *ffe_printable_name (tree decl, int v);
-static void ffe_print_error_function (diagnostic_context *, const char *);
-static tree lookup_name_current_level (tree name);
-static struct f_binding_level *make_binding_level (void);
-static void pop_f_function_context (void);
-static void push_f_function_context (void);
-static void push_parm_decl (tree parm);
-static tree pushdecl_top_level (tree decl);
-static int kept_level_p (void);
-static tree storedecls (tree decls);
-static void store_parm_decls (int is_main_program);
-static tree start_decl (tree decl, bool is_top_level);
-static void start_function (tree name, tree type, int nested, int public);
-static void ffecom_file_ (const char *name);
-static void ffecom_close_include_ (FILE *f);
-static FILE *ffecom_open_include_ (char *name, ffewhereLine l,
-				   ffewhereColumn c);
-
-/* Static objects accessed by functions in this module. */
-
-static ffesymbol ffecom_primary_entry_ = NULL;
-static ffesymbol ffecom_nested_entry_ = NULL;
-static ffeinfoKind ffecom_primary_entry_kind_;
-static bool ffecom_primary_entry_is_proc_;
-static GTY(()) tree ffecom_outer_function_decl_;
-static GTY(()) tree ffecom_previous_function_decl_;
-static GTY(()) tree ffecom_which_entrypoint_decl_;
-static GTY(()) tree ffecom_float_zero_;
-static GTY(()) tree ffecom_float_half_;
-static GTY(()) tree ffecom_double_zero_;
-static GTY(()) tree ffecom_double_half_;
-static GTY(()) tree ffecom_func_result_;/* For functions. */
-static GTY(()) tree ffecom_func_length_;/* For CHARACTER fns. */
-static ffebld ffecom_list_blockdata_;
-static ffebld ffecom_list_common_;
-static ffebld ffecom_master_arglist_;
-static ffeinfoBasictype ffecom_master_bt_;
-static ffeinfoKindtype ffecom_master_kt_;
-static ffetargetCharacterSize ffecom_master_size_;
-static int ffecom_num_fns_ = 0;
-static int ffecom_num_entrypoints_ = 0;
-static bool ffecom_is_altreturning_ = FALSE;
-static GTY(()) tree ffecom_multi_type_node_;
-static GTY(()) tree ffecom_multi_retval_;
-static GTY(()) tree
-  ffecom_multi_fields_[FFEINFO_basictype][FFEINFO_kindtype];
-static bool ffecom_member_namelisted_;	/* _member_phase1_ namelisted? */
-static bool ffecom_doing_entry_ = FALSE;
-static bool ffecom_transform_only_dummies_ = FALSE;
-static int ffecom_typesize_pointer_;
-static int ffecom_typesize_integer1_;
-
-/* Holds pointer-to-function expressions.  */
-
-static GTY(()) tree ffecom_gfrt_[FFECOM_gfrt];
-
-/* Holds the external names of the functions.  */
-
-static const char *const ffecom_gfrt_name_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) NAME,
-#include "com-rt.def"
-#undef DEFGFRT
-};
-
-/* Whether the function returns.  */
-
-static const bool ffecom_gfrt_volatile_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) VOLATILE,
-#include "com-rt.def"
-#undef DEFGFRT
-};
-
-/* Whether the function returns type complex.  */
-
-static const bool ffecom_gfrt_complex_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) COMPLEX,
-#include "com-rt.def"
-#undef DEFGFRT
-};
-
-/* Whether the function is const
-   (i.e., has no side effects and only depends on its arguments).  */
-
-static const bool ffecom_gfrt_const_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CONST,
-#include "com-rt.def"
-#undef DEFGFRT
-};
-
-/* Type code for the function return value.  */
-
-static const ffecomRttype_ ffecom_gfrt_type_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) TYPE,
-#include "com-rt.def"
-#undef DEFGFRT
-};
-
-/* String of codes for the function's arguments.  */
-
-static const char *const ffecom_gfrt_argstring_[FFECOM_gfrt]
-=
-{
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) ARGS,
-#include "com-rt.def"
-#undef DEFGFRT
-};
-
-/* Internal macros. */
-
-/* We let tm.h override the types used here, to handle trivial differences
-   such as the choice of unsigned int or long unsigned int for size_t.
-   When machines start needing nontrivial differences in the size type,
-   it would be best to do something here to figure out automatically
-   from other information what type to use.  */
-
-#ifndef SIZE_TYPE
-#define SIZE_TYPE "long unsigned int"
-#endif
-
-#define ffecom_concat_list_count_(catlist) ((catlist).count)
-#define ffecom_concat_list_expr_(catlist,i) ((catlist).exprs[(i)])
-#define ffecom_concat_list_maxlen_(catlist) ((catlist).maxlen)
-#define ffecom_concat_list_minlen_(catlist) ((catlist).minlen)
-
-#define ffecom_char_args_(i,l,e) ffecom_char_args_x_((i),(l),(e),FALSE)
-#define ffecom_char_args_with_null_(i,l,e) ffecom_char_args_x_((i),(l),(e),TRUE)
-
-/* For each binding contour we allocate a binding_level structure
- * which records the names defined in that contour.
- * Contours include:
- *  0) the global one
- *  1) one for each function definition,
- *     where internal declarations of the parameters appear.
- *
- * The current meaning of a name can be found by searching the levels from
- * the current one out to the global one.
- */
-
-/* Note that the information in the `names' component of the global contour
-   is duplicated in the IDENTIFIER_GLOBAL_VALUEs of all identifiers.  */
-
-struct f_binding_level GTY(())
-  {
-    /* A chain of _DECL nodes for all variables, constants, functions,
-       and typedef types.  These are in the reverse of the order supplied.
-     */
-    tree names;
-
-    /* For each level (except not the global one),
-       a chain of BLOCK nodes for all the levels
-       that were entered and exited one level down.  */
-    tree blocks;
-
-    /* The BLOCK node for this level, if one has been preallocated.
-       If 0, the BLOCK is allocated (if needed) when the level is popped.  */
-    tree this_block;
-
-    /* The binding level which this one is contained in (inherits from).  */
-    struct f_binding_level *level_chain;
-
-    /* 0: no ffecom_prepare_* functions called at this level yet;
-       1: ffecom_prepare* functions called, except not ffecom_prepare_end;
-       2: ffecom_prepare_end called.  */
-    int prep_state;
-  };
-
-#define NULL_BINDING_LEVEL (struct f_binding_level *) NULL
-
-/* The binding level currently in effect.  */
-
-static GTY(()) struct f_binding_level *current_binding_level;
-
-/* A chain of binding_level structures awaiting reuse.  */
-
-static GTY((deletable)) struct f_binding_level *free_binding_level;
-
-/* The outermost binding level, for names of file scope.
-   This is created when the compiler is started and exists
-   through the entire run.  */
-
-static struct f_binding_level *global_binding_level;
-
-/* Binding level structures are initialized by copying this one.  */
-
-static const struct f_binding_level clear_binding_level
-=
-{NULL, NULL, NULL, NULL_BINDING_LEVEL, 0};
-
-/* Language-dependent contents of an identifier.  */
-
-struct lang_identifier GTY(())
-{
-  struct tree_identifier common;
-  tree global_value;
-  tree local_value;
-  tree label_value;
-  bool invented;
-};
-
-/* Macros for access to language-specific slots in an identifier.  */
-/* Each of these slots contains a DECL node or null.  */
-
-/* This represents the value which the identifier has in the
-   file-scope namespace.  */
-#define IDENTIFIER_GLOBAL_VALUE(NODE)	\
-  (((struct lang_identifier *)(NODE))->global_value)
-/* This represents the value which the identifier has in the current
-   scope.  */
-#define IDENTIFIER_LOCAL_VALUE(NODE)	\
-  (((struct lang_identifier *)(NODE))->local_value)
-/* This represents the value which the identifier has as a label in
-   the current label scope.  */
-#define IDENTIFIER_LABEL_VALUE(NODE)	\
-  (((struct lang_identifier *)(NODE))->label_value)
-/* This is nonzero if the identifier was "made up" by g77 code.  */
-#define IDENTIFIER_INVENTED(NODE)	\
-  (((struct lang_identifier *)(NODE))->invented)
-
-/* The resulting tree type.  */
-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)")))
-    generic;
-  struct lang_identifier GTY ((tag ("1"))) identifier;
-};
-
-/* Fortran doesn't use either of these.  */
-struct lang_decl GTY(())
-{
-};
-struct lang_type GTY(())
-{
-};
-
-/* In identifiers, C uses the following fields in a special way:
-   TREE_PUBLIC	      to record that there was a previous local extern decl.
-   TREE_USED	      to record that such a decl was used.
-   TREE_ADDRESSABLE   to record that the address of such a decl was used.  */
-
-/* A list (chain of TREE_LIST nodes) of all LABEL_DECLs in the function
-   that have names.  Here so we can clear out their names' definitions
-   at the end of the function.  */
-
-static GTY(()) tree named_labels;
-
-/* A list of LABEL_DECLs from outer contexts that are currently shadowed.  */
-
-static GTY(()) tree shadowed_labels;
-
-/* Return the subscript expression, modified to do range-checking.
-
-   `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, tree item)
-{
-  tree low = TYPE_MIN_VALUE (TYPE_DOMAIN (array));
-  tree high = TYPE_MAX_VALUE (TYPE_DOMAIN (array));
-  tree cond;
-  tree die;
-  tree args;
-
-  if (element == error_mark_node)
-    return element;
-
-  if (TREE_TYPE (low) != TREE_TYPE (element))
-    {
-      if (TYPE_PRECISION (TREE_TYPE (low))
-	  > TYPE_PRECISION (TREE_TYPE (element)))
-	element = convert (TREE_TYPE (low), element);
-      else
-	{
-	  low = convert (TREE_TYPE (element), low);
-	  if (high)
-	    high = convert (TREE_TYPE (element), high);
-	}
-    }
-
-  element = ffecom_save_tree (element);
-  if (total_dims == 0)
-    {
-      /* Special handling for substring range checks.  Fortran allows the
-         end subscript < begin subscript, which means that expressions like
-       string(1:0) are valid (and yield a null string).  In view of this,
-       enforce two simpler conditions:
-          1) element<=high for end-substring;
-          2) element>=low for start-substring.
-       Run-time character movement will enforce remaining conditions.
-
-       More complicated checks would be better, but present structure only
-       provides one index element at a time, so it is not possible to
-       enforce a check of both i and j in string(i:j).  If it were, the
-       complete set of rules would read,
-         if ( ((j<i) && ((low<=i<=high) || (low<=j<=high))) ||
-              ((low<=i<=high) && (low<=j<=high)) )
-           ok ;
-         else
-           range error ;
-      */
-      if (dim)
-        cond = ffecom_2 (LE_EXPR, integer_type_node, element, high);
-      else
-        cond = ffecom_2 (LE_EXPR, integer_type_node, low, element);
-    }
-  else
-    {
-      /* Array reference substring range checking.  */
-
-      cond = ffecom_2 (LE_EXPR, integer_type_node,
-                     low,
-                     element);
-      if (high)
-        {
-          cond = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
-                         cond,
-                         ffecom_2 (LE_EXPR, integer_type_node,
-                                   element,
-                                   high));
-        }
-    }
-
-  /* If the array index is safe at compile-time, return element.  */
-  if (integer_nonzerop (cond))
-    return element;
-
-  {
-    int len;
-    char *proc;
-    char *var;
-    tree arg3;
-    tree arg2;
-    tree arg1;
-    tree arg4;
-
-    switch (total_dims)
-      {
-      case 0:
-	var = concat (array_name, "[", (dim ? "end" : "start"),
-		      "-substring]", NULL);
-	len = strlen (var) + 1;
-	arg1 = build_string (len, var);
-	free (var);
-	break;
-
-      case 1:
-	len = strlen (array_name) + 1;
-	arg1 = build_string (len, array_name);
-	break;
-
-      default:
-	var = xmalloc (strlen (array_name) + 40);
-	sprintf (var, "%s[subscript-%d-of-%d]",
-		 array_name,
-		 dim + 1, total_dims);
-	len = strlen (var) + 1;
-	arg1 = build_string (len, var);
-	free (var);
-	break;
-      }
-
-    TREE_TYPE (arg1)
-      = build_type_variant (build_array_type (char_type_node,
-					      build_range_type
-					      (integer_type_node,
-					       integer_one_node,
-					       build_int_2 (len, 0))),
-			    1, 0);
-    TREE_CONSTANT (arg1) = 1;
-    TREE_STATIC (arg1) = 1;
-    arg1 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg1)),
-		     arg1);
-
-    /* s_rnge adds one to the element to print it, so bias against
-       that -- want to print a faithful *subscript* value.  */
-    arg2 = convert (ffecom_f2c_ftnint_type_node,
-		    ffecom_2 (MINUS_EXPR,
-			      TREE_TYPE (element),
-			      element,
-			      convert (TREE_TYPE (element),
-				       integer_one_node)));
-
-    proc = concat (input_filename, "/",
-		   IDENTIFIER_POINTER (DECL_NAME (current_function_decl)),
-		   NULL);
-    len = strlen (proc) + 1;
-    arg3 = build_string (len, proc);
-
-    free (proc);
-
-    TREE_TYPE (arg3)
-      = build_type_variant (build_array_type (char_type_node,
-					      build_range_type
-					      (integer_type_node,
-					       integer_one_node,
-					       build_int_2 (len, 0))),
-			    1, 0);
-    TREE_CONSTANT (arg3) = 1;
-    TREE_STATIC (arg3) = 1;
-    arg3 = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (arg3)),
-		     arg3);
-
-    arg4 = convert (ffecom_f2c_ftnint_type_node,
-		    build_int_2 (input_line, 0));
-
-    arg1 = build_tree_list (NULL_TREE, arg1);
-    arg2 = build_tree_list (NULL_TREE, arg2);
-    arg3 = build_tree_list (NULL_TREE, arg3);
-    arg4 = build_tree_list (NULL_TREE, arg4);
-    TREE_CHAIN (arg3) = arg4;
-    TREE_CHAIN (arg2) = arg3;
-    TREE_CHAIN (arg1) = arg2;
-
-    args = arg1;
-  }
-  die = ffecom_call_gfrt (FFECOM_gfrtRANGE,
-			  args, NULL_TREE);
-  TREE_SIDE_EFFECTS (die) = 1;
-  die = convert (void_type_node, die);
-
-  if (integer_zerop (cond) && item)
-    ffe_mark_addressable (item);
-
-  return ffecom_3 (COND_EXPR, TREE_TYPE (element), cond, element, die);
-}
-
-/* Return the computed element of an array reference.
-
-   `item' is NULL_TREE, or the transformed pointer to the array.
-   `expr' is the original opARRAYREF expression, which is transformed
-     if `item' is NULL_TREE.
-   `want_ptr' is nonzero if a pointer to the element, instead of
-     the element itself, is to be returned.  */
-
-static tree
-ffecom_arrayref_ (tree item, ffebld expr, int want_ptr)
-{
-  ffebld dims[FFECOM_dimensionsMAX];
-  int i;
-  int total_dims;
-  int flatten = ffe_is_flatten_arrays ();
-  int need_ptr;
-  tree array;
-  tree element;
-  tree tree_type;
-  tree tree_type_x;
-  const char *array_name;
-  ffetype type;
-  ffebld list;
-
-  if (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER)
-    array_name = ffesymbol_text (ffebld_symter (ffebld_left (expr)));
-  else
-    array_name = "[expr?]";
-
-  /* Build up ARRAY_REFs in reverse order (since we're column major
-     here in Fortran land). */
-
-  for (i = 0, list = ffebld_right (expr);
-       list != NULL;
-       ++i, list = ffebld_trail (list))
-    {
-      dims[i] = ffebld_head (list);
-      type = ffeinfo_type (ffebld_basictype (dims[i]),
-			   ffebld_kindtype (dims[i]));
-      if (! flatten
-	  && ffecom_typesize_pointer_ > ffecom_typesize_integer1_
-	  && ffetype_size (type) > ffecom_typesize_integer1_)
-	/* E.g. ARRAY(INDEX), given INTEGER*8 INDEX, on a system with 64-bit
-	   pointers and 32-bit integers.  Do the full 64-bit pointer
-	   arithmetic, for codes using arrays for nonstandard heap-like
-	   work.  */
-	flatten = 1;
-    }
-
-  total_dims = i;
-
-  need_ptr = want_ptr || flatten;
-
-  if (! item)
-    {
-      if (need_ptr)
-	item = ffecom_ptr_to_expr (ffebld_left (expr));
-      else
-	item = ffecom_expr (ffebld_left (expr));
-
-      if (item == error_mark_node)
-	return item;
-
-      if (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereFLEETING
-	  && ! ffe_mark_addressable (item))
-	return error_mark_node;
-    }
-
-  if (item == error_mark_node)
-    return item;
-
-  if (need_ptr)
-    {
-      tree min;
-
-      for (--i, array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
-	   i >= 0;
-	   --i, array = TYPE_MAIN_VARIANT (TREE_TYPE (array)))
-	{
-	  min = TYPE_MIN_VALUE (TYPE_DOMAIN (array));
-	  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, item);
-	  if (element == error_mark_node)
-	    return element;
-
-	  /* Widen integral arithmetic as desired while preserving
-	     signedness.  */
-	  tree_type = TREE_TYPE (element);
-	  tree_type_x = tree_type;
-	  if (tree_type
-	      && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT
-	      && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype))
-	    tree_type_x = (TYPE_UNSIGNED (tree_type) ? usizetype : ssizetype);
-
-	  if (TREE_TYPE (min) != tree_type_x)
-	    min = convert (tree_type_x, min);
-	  if (TREE_TYPE (element) != tree_type_x)
-	    element = convert (tree_type_x, element);
-
-	  item = ffecom_2 (PLUS_EXPR,
-			   build_pointer_type (TREE_TYPE (array)),
-			   item,
-			   size_binop (MULT_EXPR,
-				       size_in_bytes (TREE_TYPE (array)),
-				       convert (sizetype,
-						fold (build (MINUS_EXPR,
-							     tree_type_x,
-							     element, min)))));
-	}
-      if (! want_ptr)
-	{
-	  item = ffecom_1 (INDIRECT_REF,
-			   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))),
-			   item);
-	}
-    }
-  else
-    {
-      for (--i;
-	   i >= 0;
-	   --i)
-	{
-	  array = TYPE_MAIN_VARIANT (TREE_TYPE (item));
-
-	  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, item);
-	  if (element == error_mark_node)
-	    return element;
-
-	  /* Widen integral arithmetic as desired while preserving
-	     signedness.  */
-	  tree_type = TREE_TYPE (element);
-	  tree_type_x = tree_type;
-	  if (tree_type
-	      && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT
-	      && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype))
-	    tree_type_x = (TYPE_UNSIGNED (tree_type) ? usizetype : ssizetype);
-
-	  element = convert (tree_type_x, element);
-
-	  item = ffecom_2 (ARRAY_REF,
-			   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item))),
-			   item,
-			   element);
-	}
-    }
-
-  return item;
-}
-
-/* This is like gcc's stabilize_reference -- in fact, most of the code
-   comes from that -- but it handles the situation where the reference
-   is going to have its subparts picked at, and it shouldn't change
-   (or trigger extra invocations of functions in the subtrees) due to
-   this.  save_expr is a bit overzealous, because we don't need the
-   entire thing calculated and saved like a temp.  So, for DECLs, no
-   change is needed, because these are stable aggregates, and ARRAY_REF
-   and such might well be stable too, but for things like calculations,
-   we do need to calculate a snapshot of a value before picking at it.  */
-
-static tree
-ffecom_stabilize_aggregate_ (tree ref)
-{
-  tree result;
-  enum tree_code code = TREE_CODE (ref);
-
-  switch (code)
-    {
-    case VAR_DECL:
-    case PARM_DECL:
-    case RESULT_DECL:
-      /* No action is needed in this case.  */
-      return ref;
-
-    case NOP_EXPR:
-    case CONVERT_EXPR:
-    case FLOAT_EXPR:
-    case FIX_TRUNC_EXPR:
-    case FIX_FLOOR_EXPR:
-    case FIX_ROUND_EXPR:
-    case FIX_CEIL_EXPR:
-      result = build_nt (code, stabilize_reference (TREE_OPERAND (ref, 0)));
-      break;
-
-    case INDIRECT_REF:
-      result = build_nt (INDIRECT_REF,
-			 stabilize_reference_1 (TREE_OPERAND (ref, 0)));
-      break;
-
-    case COMPONENT_REF:
-      result = build_nt (COMPONENT_REF,
-			 stabilize_reference (TREE_OPERAND (ref, 0)),
-			 TREE_OPERAND (ref, 1));
-      break;
-
-    case BIT_FIELD_REF:
-      result = build_nt (BIT_FIELD_REF,
-			 stabilize_reference (TREE_OPERAND (ref, 0)),
-			 stabilize_reference_1 (TREE_OPERAND (ref, 1)),
-			 stabilize_reference_1 (TREE_OPERAND (ref, 2)));
-      break;
-
-    case ARRAY_REF:
-      result = build_nt (ARRAY_REF,
-			 stabilize_reference (TREE_OPERAND (ref, 0)),
-			 stabilize_reference_1 (TREE_OPERAND (ref, 1)));
-      break;
-
-    case COMPOUND_EXPR:
-      result = build_nt (COMPOUND_EXPR,
-			 stabilize_reference_1 (TREE_OPERAND (ref, 0)),
-			 stabilize_reference (TREE_OPERAND (ref, 1)));
-      break;
-
-    case RTL_EXPR:
-      abort ();
-
-
-    default:
-      return save_expr (ref);
-
-    case ERROR_MARK:
-      return error_mark_node;
-    }
-
-  TREE_TYPE (result) = TREE_TYPE (ref);
-  TREE_READONLY (result) = TREE_READONLY (ref);
-  TREE_SIDE_EFFECTS (result) = TREE_SIDE_EFFECTS (ref);
-  TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
-
-  return result;
-}
-
-/* A rip-off of gcc's convert.c convert_to_complex function,
-   reworked to handle complex implemented as C structures
-   (RECORD_TYPE with two fields, real and imaginary `r' and `i').  */
-
-static tree
-ffecom_convert_to_complex_ (tree type, tree expr)
-{
-  register enum tree_code form = TREE_CODE (TREE_TYPE (expr));
-  tree subtype;
-
-  assert (TREE_CODE (type) == RECORD_TYPE);
-
-  subtype = TREE_TYPE (TYPE_FIELDS (type));
-
-  if (form == REAL_TYPE || form == INTEGER_TYPE || form == ENUMERAL_TYPE)
-    {
-      expr = convert (subtype, expr);
-      return ffecom_2 (COMPLEX_EXPR, type, expr,
-		       convert (subtype, integer_zero_node));
-    }
-
-  if (form == RECORD_TYPE)
-    {
-      tree elt_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr)));
-      if (TYPE_MAIN_VARIANT (elt_type) == TYPE_MAIN_VARIANT (subtype))
-	return expr;
-      else
-	{
-	  expr = save_expr (expr);
-	  return ffecom_2 (COMPLEX_EXPR,
-			   type,
-			   convert (subtype,
-				    ffecom_1 (REALPART_EXPR,
-					      TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr))),
-					      expr)),
-			   convert (subtype,
-				    ffecom_1 (IMAGPART_EXPR,
-					      TREE_TYPE (TYPE_FIELDS (TREE_TYPE (expr))),
-					      expr)));
-	}
-    }
-
-  if (form == POINTER_TYPE || form == REFERENCE_TYPE)
-    error ("pointer value used where a complex was expected");
-  else
-    error ("aggregate value used where a complex was expected");
-
-  return ffecom_2 (COMPLEX_EXPR, type,
-		   convert (subtype, integer_zero_node),
-		   convert (subtype, integer_zero_node));
-}
-
-/* Like gcc's convert(), but crashes if widening might happen.  */
-
-static tree
-ffecom_convert_narrow_ (tree type, tree expr)
-{
-  register tree e = expr;
-  register enum tree_code code = TREE_CODE (type);
-
-  if (type == TREE_TYPE (e)
-      || TREE_CODE (e) == ERROR_MARK)
-    return e;
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
-    return fold (build1 (NOP_EXPR, type, e));
-  if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
-      || code == ERROR_MARK)
-    return error_mark_node;
-  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
-    {
-      assert ("void value not ignored as it ought to be" == NULL);
-      return error_mark_node;
-    }
-  assert (code != VOID_TYPE);
-  if ((code != RECORD_TYPE)
-      && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
-    assert ("converting COMPLEX to REAL" == NULL);
-  assert (code != ENUMERAL_TYPE);
-  if (code == INTEGER_TYPE)
-    {
-      assert ((TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE
-	       && TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e)))
-	      || (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE
-		  && (TYPE_PRECISION (type)
-		      == TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (e))))));
-      return fold (convert_to_integer (type, e));
-    }
-  if (code == POINTER_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE);
-      return fold (convert_to_pointer (type, e));
-    }
-  if (code == REAL_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE);
-      assert (TYPE_PRECISION (type) <= TYPE_PRECISION (TREE_TYPE (e)));
-      return fold (convert_to_real (type, e));
-    }
-  if (code == COMPLEX_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE);
-      assert (TYPE_PRECISION (TREE_TYPE (type)) <= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e))));
-      return fold (convert_to_complex (type, e));
-    }
-  if (code == RECORD_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE);
-      /* Check that at least the first field name agrees.  */
-      assert (DECL_NAME (TYPE_FIELDS (type))
-	      == DECL_NAME (TYPE_FIELDS (TREE_TYPE (e))));
-      assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
-	      <= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
-      if (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
-	  == TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))))
-	return e;
-      return fold (ffecom_convert_to_complex_ (type, e));
-    }
-
-  assert ("conversion to non-scalar type requested" == NULL);
-  return error_mark_node;
-}
-
-/* Like gcc's convert(), but crashes if narrowing might happen.  */
-
-static tree
-ffecom_convert_widen_ (tree type, tree expr)
-{
-  register tree e = expr;
-  register enum tree_code code = TREE_CODE (type);
-
-  if (type == TREE_TYPE (e)
-      || TREE_CODE (e) == ERROR_MARK)
-    return e;
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
-    return fold (build1 (NOP_EXPR, type, e));
-  if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
-      || code == ERROR_MARK)
-    return error_mark_node;
-  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
-    {
-      assert ("void value not ignored as it ought to be" == NULL);
-      return error_mark_node;
-    }
-  assert (code != VOID_TYPE);
-  if ((code != RECORD_TYPE)
-      && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
-    assert ("narrowing COMPLEX to REAL" == NULL);
-  assert (code != ENUMERAL_TYPE);
-  if (code == INTEGER_TYPE)
-    {
-      assert ((TREE_CODE (TREE_TYPE (e)) == INTEGER_TYPE
-	       && TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e)))
-	      || (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE
-		  && (TYPE_PRECISION (type)
-		      == TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (e))))));
-      return fold (convert_to_integer (type, e));
-    }
-  if (code == POINTER_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == POINTER_TYPE);
-      return fold (convert_to_pointer (type, e));
-    }
-  if (code == REAL_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == REAL_TYPE);
-      assert (TYPE_PRECISION (type) >= TYPE_PRECISION (TREE_TYPE (e)));
-      return fold (convert_to_real (type, e));
-    }
-  if (code == COMPLEX_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == COMPLEX_TYPE);
-      assert (TYPE_PRECISION (TREE_TYPE (type)) >= TYPE_PRECISION (TREE_TYPE (TREE_TYPE (e))));
-      return fold (convert_to_complex (type, e));
-    }
-  if (code == RECORD_TYPE)
-    {
-      assert (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE);
-      /* Check that at least the first field name agrees.  */
-      assert (DECL_NAME (TYPE_FIELDS (type))
-	      == DECL_NAME (TYPE_FIELDS (TREE_TYPE (e))));
-      assert (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
-	      >= TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))));
-      if (TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (type)))
-	  == TYPE_PRECISION (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e)))))
-	return e;
-      return fold (ffecom_convert_to_complex_ (type, e));
-    }
-
-  assert ("conversion to non-scalar type requested" == NULL);
-  return error_mark_node;
-}
-
-/* Handles making a COMPLEX type, either the standard
-   (but buggy?) gbe way, or the safer (but less elegant?)
-   f2c way.  */
-
-static tree
-ffecom_make_complex_type_ (tree subtype)
-{
-  tree type;
-  tree realfield;
-  tree imagfield;
-
-  if (ffe_is_emulate_complex ())
-    {
-      type = make_node (RECORD_TYPE);
-      realfield = ffecom_decl_field (type, NULL_TREE, "r", subtype);
-      imagfield = ffecom_decl_field (type, realfield, "i", subtype);
-      TYPE_FIELDS (type) = realfield;
-      layout_type (type);
-    }
-  else
-    {
-      type = make_node (COMPLEX_TYPE);
-      TREE_TYPE (type) = subtype;
-      layout_type (type);
-    }
-
-  return type;
-}
-
-/* Chooses either the gbe or the f2c way to build a
-   complex constant.  */
-
-static tree
-ffecom_build_complex_constant_ (tree type, tree realpart, tree imagpart)
-{
-  tree bothparts;
-
-  if (ffe_is_emulate_complex ())
-    {
-      bothparts = build_tree_list (TYPE_FIELDS (type), realpart);
-      TREE_CHAIN (bothparts) = build_tree_list (TREE_CHAIN (TYPE_FIELDS (type)), imagpart);
-      bothparts = build_constructor (type, bothparts);
-    }
-  else
-    {
-      bothparts = build_complex (type, realpart, imagpart);
-    }
-
-  return bothparts;
-}
-
-static tree
-ffecom_arglist_expr_ (const char *c, ffebld expr)
-{
-  tree list;
-  tree *plist = &list;
-  tree trail = NULL_TREE;	/* Append char length args here. */
-  tree *ptrail = &trail;
-  tree length;
-  ffebld exprh;
-  tree item;
-  bool ptr = FALSE;
-  tree wanted = NULL_TREE;
-  static const char zed[] = "0";
-
-  if (c == NULL)
-    c = &zed[0];
-
-  while (expr != NULL)
-    {
-      if (*c != '\0')
-	{
-	  ptr = FALSE;
-	  if (*c == '&')
-	    {
-	      ptr = TRUE;
-	      ++c;
-	    }
-	  switch (*(c++))
-	    {
-	    case '\0':
-	      ptr = TRUE;
-	      wanted = NULL_TREE;
-	      break;
-
-	    case 'a':
-	      assert (ptr);
-	      wanted = NULL_TREE;
-	      break;
-
-	    case 'c':
-	      wanted = ffecom_f2c_complex_type_node;
-	      break;
-
-	    case 'd':
-	      wanted = ffecom_f2c_doublereal_type_node;
-	      break;
-
-	    case 'e':
-	      wanted = ffecom_f2c_doublecomplex_type_node;
-	      break;
-
-	    case 'f':
-	      wanted = ffecom_f2c_real_type_node;
-	      break;
-
-	    case 'i':
-	      wanted = ffecom_f2c_integer_type_node;
-	      break;
-
-	    case 'j':
-	      wanted = ffecom_f2c_longint_type_node;
-	      break;
-
-	    default:
-	      assert ("bad argstring code" == NULL);
-	      wanted = NULL_TREE;
-	      break;
-	    }
-	}
-
-      exprh = ffebld_head (expr);
-      if (exprh == NULL)
-	wanted = NULL_TREE;
-
-      if ((wanted == NULL_TREE)
-	  || (ptr
-	      && (TYPE_MODE
-		  (ffecom_tree_type[ffeinfo_basictype (ffebld_info (exprh))]
-		   [ffeinfo_kindtype (ffebld_info (exprh))])
-		   == TYPE_MODE (wanted))))
-	*plist
-	  = build_tree_list (NULL_TREE,
-			     ffecom_arg_ptr_to_expr (exprh,
-						     &length));
-      else
-	{
-	  item = ffecom_arg_expr (exprh, &length);
-	  item = ffecom_convert_widen_ (wanted, item);
-	  if (ptr)
-	    {
-	      item = ffecom_1 (ADDR_EXPR,
-			       build_pointer_type (TREE_TYPE (item)),
-			       item);
-	    }
-	  *plist
-	    = build_tree_list (NULL_TREE,
-			       item);
-	}
-
-      plist = &TREE_CHAIN (*plist);
-      expr = ffebld_trail (expr);
-      if (length != NULL_TREE)
-	{
-	  *ptrail = build_tree_list (NULL_TREE, length);
-	  ptrail = &TREE_CHAIN (*ptrail);
-	}
-    }
-
-  /* We've run out of args in the call; if the implementation expects
-     more, supply null pointers for them, which the implementation can
-     check to see if an arg was omitted. */
-
-  while (*c != '\0' && *c != '0')
-    {
-      if (*c == '&')
-	++c;
-      else
-	assert ("missing arg to run-time routine!" == NULL);
-
-      switch (*(c++))
-	{
-	case '\0':
-	case 'a':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'i':
-	case 'j':
-	  break;
-
-	default:
-	  assert ("bad arg string code" == NULL);
-	  break;
-	}
-      *plist
-	= build_tree_list (NULL_TREE,
-			   null_pointer_node);
-      plist = &TREE_CHAIN (*plist);
-    }
-
-  *plist = trail;
-
-  return list;
-}
-
-static tree
-ffecom_widest_expr_type_ (ffebld list)
-{
-  ffebld item;
-  ffebld widest = NULL;
-  ffetype type;
-  ffetype widest_type = NULL;
-  tree t;
-
-  for (; list != NULL; list = ffebld_trail (list))
-    {
-      item = ffebld_head (list);
-      if (item == NULL)
-	continue;
-      if ((widest != NULL)
-	  && (ffeinfo_basictype (ffebld_info (item))
-	      != ffeinfo_basictype (ffebld_info (widest))))
-	continue;
-      type = ffeinfo_type (ffeinfo_basictype (ffebld_info (item)),
-			   ffeinfo_kindtype (ffebld_info (item)));
-      if ((widest == FFEINFO_kindtypeNONE)
-	  || (ffetype_size (type)
-	      > ffetype_size (widest_type)))
-	{
-	  widest = item;
-	  widest_type = type;
-	}
-    }
-
-  assert (widest != NULL);
-  t = ffecom_tree_type[ffeinfo_basictype (ffebld_info (widest))]
-    [ffeinfo_kindtype (ffebld_info (widest))];
-  assert (t != NULL_TREE);
-  return t;
-}
-
-/* Check whether a partial overlap between two expressions is possible.
-
-   Can *starting* to write a portion of expr1 change the value
-   computed (perhaps already, *partially*) by expr2?
-
-   Currently, this is a concern only for a COMPLEX expr1.  But if it
-   isn't in COMMON or local EQUIVALENCE, since we don't support
-   aliasing of arguments, it isn't a concern.  */
-
-static bool
-ffecom_possible_partial_overlap_ (ffebld expr1, ffebld expr2 ATTRIBUTE_UNUSED)
-{
-  ffesymbol sym;
-  ffestorag st;
-
-  switch (ffebld_op (expr1))
-    {
-    case FFEBLD_opSYMTER:
-      sym = ffebld_symter (expr1);
-      break;
-
-    case FFEBLD_opARRAYREF:
-      if (ffebld_op (ffebld_left (expr1)) != FFEBLD_opSYMTER)
-	return FALSE;
-      sym = ffebld_symter (ffebld_left (expr1));
-      break;
-
-    default:
-      return FALSE;
-    }
-
-  if (ffesymbol_where (sym) != FFEINFO_whereCOMMON
-      && (ffesymbol_where (sym) != FFEINFO_whereLOCAL
-	  || ! (st = ffesymbol_storage (sym))
-	  || ! ffestorag_parent (st)))
-    return FALSE;
-
-  /* It's in COMMON or local EQUIVALENCE.  */
-
-  return TRUE;
-}
-
-/* Check whether dest and source might overlap.  ffebld versions of these
-   might or might not be passed, will be NULL if not.
-
-   The test is really whether source_tree is modifiable and, if modified,
-   might overlap destination such that the value(s) in the destination might
-   change before it is finally modified.  dest_* are the canonized
-   destination itself.  */
-
-static bool
-ffecom_overlap_ (tree dest_decl, tree dest_offset, tree dest_size,
-		 tree source_tree, ffebld source UNUSED, bool scalar_arg)
-{
-  tree source_decl;
-  tree source_offset;
-  tree source_size;
-  tree t;
-
-  if (source_tree == NULL_TREE)
-    return FALSE;
-
-  switch (TREE_CODE (source_tree))
-    {
-    case ERROR_MARK:
-    case IDENTIFIER_NODE:
-    case INTEGER_CST:
-    case REAL_CST:
-    case COMPLEX_CST:
-    case STRING_CST:
-    case CONST_DECL:
-    case VAR_DECL:
-    case RESULT_DECL:
-    case FIELD_DECL:
-    case MINUS_EXPR:
-    case MULT_EXPR:
-    case TRUNC_DIV_EXPR:
-    case CEIL_DIV_EXPR:
-    case FLOOR_DIV_EXPR:
-    case ROUND_DIV_EXPR:
-    case TRUNC_MOD_EXPR:
-    case CEIL_MOD_EXPR:
-    case FLOOR_MOD_EXPR:
-    case ROUND_MOD_EXPR:
-    case RDIV_EXPR:
-    case EXACT_DIV_EXPR:
-    case FIX_TRUNC_EXPR:
-    case FIX_CEIL_EXPR:
-    case FIX_FLOOR_EXPR:
-    case FIX_ROUND_EXPR:
-    case FLOAT_EXPR:
-    case NEGATE_EXPR:
-    case MIN_EXPR:
-    case MAX_EXPR:
-    case ABS_EXPR:
-    case LSHIFT_EXPR:
-    case RSHIFT_EXPR:
-    case LROTATE_EXPR:
-    case RROTATE_EXPR:
-    case BIT_IOR_EXPR:
-    case BIT_XOR_EXPR:
-    case BIT_AND_EXPR:
-    case BIT_NOT_EXPR:
-    case TRUTH_ANDIF_EXPR:
-    case TRUTH_ORIF_EXPR:
-    case TRUTH_AND_EXPR:
-    case TRUTH_OR_EXPR:
-    case TRUTH_XOR_EXPR:
-    case TRUTH_NOT_EXPR:
-    case LT_EXPR:
-    case LE_EXPR:
-    case GT_EXPR:
-    case GE_EXPR:
-    case EQ_EXPR:
-    case NE_EXPR:
-    case COMPLEX_EXPR:
-    case CONJ_EXPR:
-    case REALPART_EXPR:
-    case IMAGPART_EXPR:
-    case LABEL_EXPR:
-    case COMPONENT_REF:
-      return FALSE;
-
-    case COMPOUND_EXPR:
-      return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
-			      TREE_OPERAND (source_tree, 1), NULL,
-			      scalar_arg);
-
-    case MODIFY_EXPR:
-      return ffecom_overlap_ (dest_decl, dest_offset, dest_size,
-			      TREE_OPERAND (source_tree, 0), NULL,
-			      scalar_arg);
-
-    case CONVERT_EXPR:
-    case NOP_EXPR:
-    case NON_LVALUE_EXPR:
-    case PLUS_EXPR:
-      if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
-	return TRUE;
-
-      ffecom_tree_canonize_ptr_ (&source_decl, &source_offset,
-				 source_tree);
-      source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
-      break;
-
-    case COND_EXPR:
-      return
-	ffecom_overlap_ (dest_decl, dest_offset, dest_size,
-			 TREE_OPERAND (source_tree, 1), NULL,
-			 scalar_arg)
-	  || ffecom_overlap_ (dest_decl, dest_offset, dest_size,
-			      TREE_OPERAND (source_tree, 2), NULL,
-			      scalar_arg);
-
-
-    case ADDR_EXPR:
-      ffecom_tree_canonize_ref_ (&source_decl, &source_offset,
-				 &source_size,
-				 TREE_OPERAND (source_tree, 0));
-      break;
-
-    case PARM_DECL:
-      if (TREE_CODE (TREE_TYPE (source_tree)) != POINTER_TYPE)
-	return TRUE;
-
-      source_decl = source_tree;
-      source_offset = bitsize_zero_node;
-      source_size = TYPE_SIZE (TREE_TYPE (TREE_TYPE (source_tree)));
-      break;
-
-    case SAVE_EXPR:
-    case REFERENCE_EXPR:
-    case PREDECREMENT_EXPR:
-    case PREINCREMENT_EXPR:
-    case POSTDECREMENT_EXPR:
-    case POSTINCREMENT_EXPR:
-    case INDIRECT_REF:
-    case ARRAY_REF:
-    case CALL_EXPR:
-    default:
-      return TRUE;
-    }
-
-  /* Come here when source_decl, source_offset, and source_size filled
-     in appropriately.  */
-
-  if (source_decl == NULL_TREE)
-    return FALSE;		/* No decl involved, so no overlap. */
-
-  if (source_decl != dest_decl)
-    return FALSE;		/* Different decl, no overlap. */
-
-  if (TREE_CODE (dest_size) == ERROR_MARK)
-    return TRUE;		/* Assignment into entire assumed-size
-				   array?  Shouldn't happen.... */
-
-  t = ffecom_2 (LE_EXPR, integer_type_node,
-		ffecom_2 (PLUS_EXPR, TREE_TYPE (dest_offset),
-			  dest_offset,
-			  convert (TREE_TYPE (dest_offset),
-				   dest_size)),
-		convert (TREE_TYPE (dest_offset),
-			 source_offset));
-
-  if (integer_onep (t))
-    return FALSE;		/* Destination precedes source. */
-
-  if (!scalar_arg
-      || (source_size == NULL_TREE)
-      || (TREE_CODE (source_size) == ERROR_MARK)
-      || integer_zerop (source_size))
-    return TRUE;		/* No way to tell if dest follows source. */
-
-  t = ffecom_2 (LE_EXPR, integer_type_node,
-		ffecom_2 (PLUS_EXPR, TREE_TYPE (source_offset),
-			  source_offset,
-			  convert (TREE_TYPE (source_offset),
-				   source_size)),
-		convert (TREE_TYPE (source_offset),
-			 dest_offset));
-
-  if (integer_onep (t))
-    return FALSE;		/* Destination follows source. */
-
-  return TRUE;		/* Destination and source overlap. */
-}
-
-/* Check whether dest might overlap any of a list of arguments or is
-   in a COMMON area the callee might know about (and thus modify).  */
-
-static bool
-ffecom_args_overlapping_ (tree dest_tree, ffebld dest UNUSED, tree args,
-			  tree callee_commons, bool scalar_args)
-{
-  tree arg;
-  tree dest_decl;
-  tree dest_offset;
-  tree dest_size;
-
-  ffecom_tree_canonize_ref_ (&dest_decl, &dest_offset, &dest_size,
-			     dest_tree);
-
-  if (dest_decl == NULL_TREE)
-    return FALSE;		/* Seems unlikely! */
-
-  /* If the decl cannot be determined reliably, or if its in COMMON
-     and the callee isn't known to not futz with COMMON via other
-     means, overlap might happen.  */
-
-  if ((TREE_CODE (dest_decl) == ERROR_MARK)
-      || ((callee_commons != NULL_TREE)
-	  && TREE_PUBLIC (dest_decl)))
-    return TRUE;
-
-  for (; args != NULL_TREE; args = TREE_CHAIN (args))
-    {
-      if (((arg = TREE_VALUE (args)) != NULL_TREE)
-	  && ffecom_overlap_ (dest_decl, dest_offset, dest_size,
-			      arg, NULL, scalar_args))
-	return TRUE;
-    }
-
-  return FALSE;
-}
-
-/* Build a string for a variable name as used by NAMELIST.  This means that
-   if we're using the f2c library, we build an uppercase string, since
-   f2c does this.  */
-
-static tree
-ffecom_build_f2c_string_ (int i, const char *s)
-{
-  if (!ffe_is_f2c_library ())
-    return build_string (i, s);
-
-  {
-    char *tmp;
-    const char *p;
-    char *q;
-    char space[34];
-    tree t;
-
-    if (((size_t) i) > ARRAY_SIZE (space))
-      tmp = malloc_new_ks (malloc_pool_image (), "f2c_string", i);
-    else
-      tmp = &space[0];
-
-    for (p = s, q = tmp; *p != '\0'; ++p, ++q)
-      *q = TOUPPER (*p);
-    *q = '\0';
-
-    t = build_string (i, tmp);
-
-    if (((size_t) i) > ARRAY_SIZE (space))
-      malloc_kill_ks (malloc_pool_image (), tmp, i);
-
-    return t;
-  }
-}
-
-/* Returns CALL_EXPR or equivalent with given type (pass NULL_TREE for
-   type to just get whatever the function returns), handling the
-   f2c value-returning convention, if required, by prepending
-   to the arglist a pointer to a temporary to receive the return value.	 */
-
-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)
-{
-  tree item;
-  tree tempvar;
-
-  if (dest_used != NULL)
-    *dest_used = FALSE;
-
-  if (is_f2c_complex)
-    {
-      if ((dest_used == NULL)
-	  || (dest == NULL)
-	  || (ffeinfo_basictype (ffebld_info (dest))
-	      != FFEINFO_basictypeCOMPLEX)
-	  || (ffeinfo_kindtype (ffebld_info (dest)) != kt)
-	  || ((type != NULL_TREE) && (TREE_TYPE (dest_tree) != type))
-	  || ffecom_args_overlapping_ (dest_tree, dest, args,
-				       callee_commons,
-				       scalar_args))
-	{
-	  tempvar = hook;
-	  assert (tempvar);
-	}
-      else
-	{
-	  *dest_used = TRUE;
-	  tempvar = dest_tree;
-	  type = NULL_TREE;
-	}
-
-      item
-	= build_tree_list (NULL_TREE,
-			   ffecom_1 (ADDR_EXPR,
-				     build_pointer_type (TREE_TYPE (tempvar)),
-				     tempvar));
-      TREE_CHAIN (item) = args;
-
-      item = ffecom_3s (CALL_EXPR, TREE_TYPE (TREE_TYPE (TREE_TYPE (fn))), fn,
-			item, NULL_TREE);
-
-      if (tempvar != dest_tree)
-	item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item, tempvar);
-    }
-  else
-    item = ffecom_3s (CALL_EXPR, TREE_TYPE (TREE_TYPE (TREE_TYPE (fn))), fn,
-		      args, NULL_TREE);
-
-  if ((type != NULL_TREE) && (TREE_TYPE (item) != type))
-    item = ffecom_convert_narrow_ (type, item);
-
-  return item;
-}
-
-/* Given two arguments, transform them and make a call to the given
-   function via ffecom_call_.  */
-
-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 left_tree;
-  tree right_tree;
-  tree left_length;
-  tree right_length;
-
-  if (ref)
-    {
-      /* Pass arguments by reference.  */
-      left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
-      right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
-    }
-  else
-    {
-      /* Pass arguments by value.  */
-      left_tree = ffecom_arg_expr (left, &left_length);
-      right_tree = ffecom_arg_expr (right, &right_length);
-    }
-
-
-  left_tree = build_tree_list (NULL_TREE, left_tree);
-  right_tree = build_tree_list (NULL_TREE, right_tree);
-  TREE_CHAIN (left_tree) = right_tree;
-
-  if (left_length != NULL_TREE)
-    {
-      left_length = build_tree_list (NULL_TREE, left_length);
-      TREE_CHAIN (right_tree) = left_length;
-    }
-
-  if (right_length != NULL_TREE)
-    {
-      right_length = build_tree_list (NULL_TREE, right_length);
-      if (left_length != NULL_TREE)
-	TREE_CHAIN (left_length) = right_length;
-      else
-	TREE_CHAIN (right_tree) = right_length;
-    }
-
-  return ffecom_call_ (fn, kt, is_f2c_complex, type, left_tree,
-		       dest_tree, dest, dest_used, callee_commons,
-		       scalar_args, hook);
-}
-
-/* Return ptr/length args for char subexpression
-
-   Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
-   subexpressions by constructing the appropriate trees for the ptr-to-
-   character-text and length-of-character-text arguments in a calling
-   sequence.
-
-   Note that if with_null is TRUE, and the expression is an opCONTER,
-   a null byte is appended to the string.  */
-
-static void
-ffecom_char_args_x_ (tree *xitem, tree *length, ffebld expr, bool with_null)
-{
-  tree item;
-  tree high;
-  ffetargetCharacter1 val;
-  ffetargetCharacterSize newlen;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opCONTER:
-      val = ffebld_constant_character1 (ffebld_conter (expr));
-      newlen = ffetarget_length_character1 (val);
-      if (with_null)
-	{
-	  /* Begin FFETARGET-NULL-KLUDGE.  */
-	  if (newlen != 0)
-	    ++newlen;
-	}
-      *length = build_int_2 (newlen, 0);
-      TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
-      high = build_int_2 (newlen, 0);
-      TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
-      item = build_string (newlen,
-			   ffetarget_text_character1 (val));
-      /* End FFETARGET-NULL-KLUDGE.  */
-      TREE_TYPE (item)
-	= build_type_variant
-	  (build_array_type
-	   (char_type_node,
-	    build_range_type
-	    (ffecom_f2c_ftnlen_type_node,
-	     ffecom_f2c_ftnlen_one_node,
-	     high)),
-	   1, 0);
-      TREE_CONSTANT (item) = 1;
-      TREE_STATIC (item) = 1;
-      item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
-		       item);
-      break;
-
-    case FFEBLD_opSYMTER:
-      {
-	ffesymbol s = ffebld_symter (expr);
-
-	item = ffesymbol_hook (s).decl_tree;
-	if (item == NULL_TREE)
-	  {
-	    s = ffecom_sym_transform_ (s);
-	    item = ffesymbol_hook (s).decl_tree;
-	  }
-	if (ffesymbol_kind (s) == FFEINFO_kindENTITY)
-	  {
-	    if (ffesymbol_size (s) == FFETARGET_charactersizeNONE)
-	      *length = ffesymbol_hook (s).length_tree;
-	    else
-	      {
-		*length = build_int_2 (ffesymbol_size (s), 0);
-		TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
-	      }
-	  }
-	else if (item == error_mark_node)
-	  *length = error_mark_node;
-	else
-	  /* FFEINFO_kindFUNCTION.  */
-	  *length = NULL_TREE;
-	if (!ffesymbol_hook (s).addr
-	    && (item != error_mark_node))
-	  item = ffecom_1 (ADDR_EXPR,
-			   build_pointer_type (TREE_TYPE (item)),
-			   item);
-      }
-      break;
-
-    case FFEBLD_opARRAYREF:
-      {
-	ffecom_char_args_ (&item, length, ffebld_left (expr));
-
-	if (item == error_mark_node || *length == error_mark_node)
-	  {
-	    item = *length = error_mark_node;
-	    break;
-	  }
-
-	item = ffecom_arrayref_ (item, expr, 1);
-      }
-      break;
-
-    case FFEBLD_opSUBSTR:
-      {
-	ffebld start;
-	ffebld end;
-	ffebld thing = ffebld_right (expr);
-	tree start_tree;
-	tree end_tree;
-	const char *char_name;
-	ffebld left_symter;
-	tree array;
-
-	assert (ffebld_op (thing) == FFEBLD_opITEM);
-	start = ffebld_head (thing);
-	thing = ffebld_trail (thing);
-	assert (ffebld_trail (thing) == NULL);
-	end = ffebld_head (thing);
-
-	/* Determine name for pretty-printing range-check errors.  */
-	for (left_symter = ffebld_left (expr);
-	     left_symter && ffebld_op (left_symter) == FFEBLD_opARRAYREF;
-	     left_symter = ffebld_left (left_symter))
-	  ;
-	if (ffebld_op (left_symter) == FFEBLD_opSYMTER)
-	  char_name = ffesymbol_text (ffebld_symter (left_symter));
-	else
-	  char_name = "[expr?]";
-
-	ffecom_char_args_ (&item, length, ffebld_left (expr));
-
-	if (item == error_mark_node || *length == error_mark_node)
-	  {
-	    item = *length = error_mark_node;
-	    break;
-	  }
-
-	array = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item)));
-
-	/* ~~~~Handle INTEGER*8 start/end, a la FFEBLD_opARRAYREF.  */
-
-	if (start == NULL)
-	  {
-	    if (end == NULL)
-	      ;
-	    else
-	      {
-		end_tree = ffecom_expr (end);
-		if (flag_bounds_check)
-		  end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
-						      char_name, NULL_TREE);
-		end_tree = convert (ffecom_f2c_ftnlen_type_node,
-				    end_tree);
-
-		if (end_tree == error_mark_node)
-		  {
-		    item = *length = error_mark_node;
-		    break;
-		  }
-
-		*length = end_tree;
-	      }
-	  }
-	else
-	  {
-	    start_tree = ffecom_expr (start);
-	    if (flag_bounds_check)
-	      start_tree = ffecom_subscript_check_ (array, start_tree, 0, 0,
-						    char_name, NULL_TREE);
-	    start_tree = convert (ffecom_f2c_ftnlen_type_node,
-				  start_tree);
-
-	    if (start_tree == error_mark_node)
-	      {
-		item = *length = error_mark_node;
-		break;
-	      }
-
-	    start_tree = ffecom_save_tree (start_tree);
-
-	    item = ffecom_2 (PLUS_EXPR, TREE_TYPE (item),
-			     item,
-			     ffecom_2 (MINUS_EXPR,
-				       TREE_TYPE (start_tree),
-				       start_tree,
-				       ffecom_f2c_ftnlen_one_node));
-
-	    if (end == NULL)
-	      {
-		*length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-				    ffecom_f2c_ftnlen_one_node,
-				    ffecom_2 (MINUS_EXPR,
-					      ffecom_f2c_ftnlen_type_node,
-					      *length,
-					      start_tree));
-	      }
-	    else
-	      {
-		end_tree = ffecom_expr (end);
-		if (flag_bounds_check)
-		  end_tree = ffecom_subscript_check_ (array, end_tree, 1, 0,
-						      char_name, NULL_TREE);
-		end_tree = convert (ffecom_f2c_ftnlen_type_node,
-				    end_tree);
-
-		if (end_tree == error_mark_node)
-		  {
-		    item = *length = error_mark_node;
-		    break;
-		  }
-
-		*length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-				    ffecom_f2c_ftnlen_one_node,
-				    ffecom_2 (MINUS_EXPR,
-					      ffecom_f2c_ftnlen_type_node,
-					      end_tree, start_tree));
-	      }
-	  }
-      }
-      break;
-
-    case FFEBLD_opFUNCREF:
-      {
-	ffesymbol s = ffebld_symter (ffebld_left (expr));
-	tree tempvar;
-	tree args;
-	ffetargetCharacterSize size = ffeinfo_size (ffebld_info (expr));
-	ffecomGfrt ix;
-
-	if (size == FFETARGET_charactersizeNONE)
-	  /* ~~Kludge alert!  This should someday be fixed. */
-	  size = 24;
-
-	*length = build_int_2 (size, 0);
-	TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
-
-	if (ffeinfo_where (ffebld_info (ffebld_left (expr)))
-	    == FFEINFO_whereINTRINSIC)
-	  {
-	    if (size == 1)
-	      {
-		/* Invocation of an intrinsic returning CHARACTER*1.  */
-		item = ffecom_expr_intrinsic_ (expr, NULL_TREE,
-					       NULL, NULL);
-		break;
-	      }
-	    ix = ffeintrin_gfrt_direct (ffebld_symter_implementation (ffebld_left (expr)));
-	    assert (ix != FFECOM_gfrt);
-	    item = ffecom_gfrt_tree_ (ix);
-	  }
-	else
-	  {
-	    ix = FFECOM_gfrt;
-	    item = ffesymbol_hook (s).decl_tree;
-	    if (item == NULL_TREE)
-	      {
-		s = ffecom_sym_transform_ (s);
-		item = ffesymbol_hook (s).decl_tree;
-	      }
-	    if (item == error_mark_node)
-	      {
-		item = *length = error_mark_node;
-		break;
-	      }
-
-	    if (!ffesymbol_hook (s).addr)
-	      item = ffecom_1_fn (item);
-	  }
-	tempvar = ffebld_nonter_hook (expr);
-	assert (tempvar);
-	tempvar = ffecom_1 (ADDR_EXPR,
-			    build_pointer_type (TREE_TYPE (tempvar)),
-			    tempvar);
-
-	args = build_tree_list (NULL_TREE, tempvar);
-
-	if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)	/* Sfunc args by value. */
-	  TREE_CHAIN (args) = ffecom_list_expr (ffebld_right (expr));
-	else
-	  {
-	    TREE_CHAIN (args) = build_tree_list (NULL_TREE, *length);
-	    if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
-	      {
-		TREE_CHAIN (TREE_CHAIN (args))
-		  = ffecom_arglist_expr_ (ffecom_gfrt_args_ (ix),
-					  ffebld_right (expr));
-	      }
-	    else
-	      {
-		TREE_CHAIN (TREE_CHAIN (args))
-		  = ffecom_list_ptr_to_expr (ffebld_right (expr));
-	      }
-	  }
-
-	item = ffecom_3s (CALL_EXPR,
-			  TREE_TYPE (TREE_TYPE (TREE_TYPE (item))),
-			  item, args, NULL_TREE);
-	item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), item,
-			 tempvar);
-      }
-      break;
-
-    case FFEBLD_opCONVERT:
-
-      ffecom_char_args_ (&item, length, ffebld_left (expr));
-
-      if (item == error_mark_node || *length == error_mark_node)
-	{
-	  item = *length = error_mark_node;
-	  break;
-	}
-
-      if ((ffebld_size_known (ffebld_left (expr))
-	   == FFETARGET_charactersizeNONE)
-	  || (ffebld_size_known (ffebld_left (expr)) < (ffebld_size (expr))))
-	{			/* Possible blank-padding needed, copy into
-				   temporary. */
-	  tree tempvar;
-	  tree args;
-	  tree newlen;
-
-	  tempvar = ffebld_nonter_hook (expr);
-	  assert (tempvar);
-	  tempvar = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (tempvar)),
-			      tempvar);
-
-	  newlen = build_int_2 (ffebld_size (expr), 0);
-	  TREE_TYPE (newlen) = ffecom_f2c_ftnlen_type_node;
-
-	  args = build_tree_list (NULL_TREE, tempvar);
-	  TREE_CHAIN (args) = build_tree_list (NULL_TREE, item);
-	  TREE_CHAIN (TREE_CHAIN (args)) = build_tree_list (NULL_TREE, newlen);
-	  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (args)))
-	    = build_tree_list (NULL_TREE, *length);
-
-	  item = ffecom_call_gfrt (FFECOM_gfrtCOPY, args, NULL_TREE);
-	  TREE_SIDE_EFFECTS (item) = 1;
-	  item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar), fold (item),
-			   tempvar);
-	  *length = newlen;
-	}
-      else
-	{			/* Just truncate the length. */
-	  *length = build_int_2 (ffebld_size (expr), 0);
-	  TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
-	}
-      break;
-
-    default:
-      assert ("bad op for single char arg expr" == NULL);
-      item = NULL_TREE;
-      break;
-    }
-
-  *xitem = item;
-}
-
-/* Check the size of the type to be sure it doesn't overflow the
-   "portable" capacities of the compiler back end.  `dummy' types
-   can generally overflow the normal sizes as long as the computations
-   themselves don't overflow.  A particular target of the back end
-   must still enforce its size requirements, though, and the back
-   end takes care of this in stor-layout.c.  */
-
-static tree
-ffecom_check_size_overflow_ (ffesymbol s, tree type, bool dummy)
-{
-  if (TREE_CODE (type) == ERROR_MARK)
-    return type;
-
-  if (TYPE_SIZE (type) == NULL_TREE)
-    return type;
-
-  if (TREE_CODE (TYPE_SIZE (type)) != INTEGER_CST)
-    return type;
-
-  /* An array is too large if size is negative or the type_size overflows
-     or its "upper half" is larger than 3 (which would make the signed
-     byte size and offset computations overflow).  */
-
-  if ((tree_int_cst_sgn (TYPE_SIZE (type)) < 0)
-      || (!dummy && (TREE_INT_CST_HIGH (TYPE_SIZE (type)) > 3
-	             || TREE_OVERFLOW (TYPE_SIZE (type)))))
-    {
-      ffebad_start (FFEBAD_ARRAY_LARGE);
-      ffebad_string (ffesymbol_text (s));
-      ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
-      ffebad_finish ();
-
-      return error_mark_node;
-    }
-
-  return type;
-}
-
-/* Builds a length argument (PARM_DECL).  Also wraps type in an array type
-   where the dimension info is (1:size) where <size> is ffesymbol_size(s) if
-   known, length_arg if not known (FFETARGET_charactersizeNONE).  */
-
-static tree
-ffecom_char_enhance_arg_ (tree *xtype, ffesymbol s)
-{
-  ffetargetCharacterSize sz = ffesymbol_size (s);
-  tree highval;
-  tree tlen;
-  tree type = *xtype;
-
-  if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
-    tlen = NULL_TREE;		/* A statement function, no length passed. */
-  else
-    {
-      if (ffesymbol_where (s) == FFEINFO_whereDUMMY)
-	tlen = ffecom_get_invented_identifier ("__g77_length_%s",
-					       ffesymbol_text (s));
-      else
-	tlen = ffecom_get_invented_identifier ("__g77_%s", "length");
-      tlen = build_decl (PARM_DECL, tlen, ffecom_f2c_ftnlen_type_node);
-      DECL_ARTIFICIAL (tlen) = 1;
-    }
-
-  if (sz == FFETARGET_charactersizeNONE)
-    {
-      assert (tlen != NULL_TREE);
-      highval = variable_size (tlen);
-    }
-  else
-    {
-      highval = build_int_2 (sz, 0);
-      TREE_TYPE (highval) = ffecom_f2c_ftnlen_type_node;
-    }
-
-  type = build_array_type (type,
-			   build_range_type (ffecom_f2c_ftnlen_type_node,
-					     ffecom_f2c_ftnlen_one_node,
-					     highval));
-
-  *xtype = type;
-  return tlen;
-}
-
-/* ffecom_concat_list_gather_ -- Gather list of concatenated string exprs
-
-   ffecomConcatList_ catlist;
-   ffebld expr;	 // expr of CHARACTER basictype.
-   ffetargetCharacterSize max;	// max chars to gather or _...NONE if no max
-   catlist = ffecom_concat_list_gather_(catlist,expr,max);
-
-   Scans expr for character subexpressions, updates and returns catlist
-   accordingly.	 */
-
-static ffecomConcatList_
-ffecom_concat_list_gather_ (ffecomConcatList_ catlist, ffebld expr,
-			    ffetargetCharacterSize max)
-{
-  ffetargetCharacterSize sz;
-
- recurse:
-
-  if (expr == NULL)
-    return catlist;
-
-  if ((max != FFETARGET_charactersizeNONE) && (catlist.minlen >= max))
-    return catlist;		/* Don't append any more items. */
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opCONTER:
-    case FFEBLD_opSYMTER:
-    case FFEBLD_opARRAYREF:
-    case FFEBLD_opFUNCREF:
-    case FFEBLD_opSUBSTR:
-    case FFEBLD_opCONVERT:	/* Callers should strip this off beforehand
-				   if they don't need to preserve it. */
-      if (catlist.count == catlist.max)
-	{			/* Make a (larger) list. */
-	  ffebld *newx;
-	  int newmax;
-
-	  newmax = (catlist.max == 0) ? 8 : catlist.max * 2;
-	  newx = malloc_new_ks (malloc_pool_image (), "catlist",
-				newmax * sizeof (newx[0]));
-	  if (catlist.max != 0)
-	    {
-	      memcpy (newx, catlist.exprs, catlist.max * sizeof (newx[0]));
-	      malloc_kill_ks (malloc_pool_image (), catlist.exprs,
-			      catlist.max * sizeof (newx[0]));
-	    }
-	  catlist.max = newmax;
-	  catlist.exprs = newx;
-	}
-      if ((sz = ffebld_size_known (expr)) != FFETARGET_charactersizeNONE)
-	catlist.minlen += sz;
-      else
-	++catlist.minlen;	/* Not true for F90; can be 0 length. */
-      if ((sz = ffebld_size_max (expr)) == FFETARGET_charactersizeNONE)
-	catlist.maxlen = sz;
-      else
-	catlist.maxlen += sz;
-      if ((max != FFETARGET_charactersizeNONE) && (catlist.minlen > max))
-	{			/* This item overlaps (or is beyond) the end
-				   of the destination. */
-	  switch (ffebld_op (expr))
-	    {
-	    case FFEBLD_opCONTER:
-	    case FFEBLD_opSYMTER:
-	    case FFEBLD_opARRAYREF:
-	    case FFEBLD_opFUNCREF:
-	    case FFEBLD_opSUBSTR:
-	      /* ~~Do useful truncations here. */
-	      break;
-
-	    default:
-	      assert ("op changed or inconsistent switches!" == NULL);
-	      break;
-	    }
-	}
-      catlist.exprs[catlist.count++] = expr;
-      return catlist;
-
-    case FFEBLD_opPAREN:
-      expr = ffebld_left (expr);
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opCONCATENATE:
-      catlist = ffecom_concat_list_gather_ (catlist, ffebld_left (expr), max);
-      expr = ffebld_right (expr);
-      goto recurse;		/* :::::::::::::::::::: */
-
-#if 0				/* Breaks passing small actual arg to larger
-				   dummy arg of sfunc */
-    case FFEBLD_opCONVERT:
-      expr = ffebld_left (expr);
-      {
-	ffetargetCharacterSize cmax;
-
-	cmax = catlist.len + ffebld_size_known (expr);
-
-	if ((max == FFETARGET_charactersizeNONE) || (max > cmax))
-	  max = cmax;
-      }
-      goto recurse;		/* :::::::::::::::::::: */
-#endif
-
-    case FFEBLD_opANY:
-      return catlist;
-
-    default:
-      assert ("bad op in _gather_" == NULL);
-      return catlist;
-    }
-}
-
-/* ffecom_concat_list_kill_ -- Kill list of concatenated string exprs
-
-   ffecomConcatList_ catlist;
-   ffecom_concat_list_kill_(catlist);
-
-   Anything allocated within the list info is deallocated.  */
-
-static void
-ffecom_concat_list_kill_ (ffecomConcatList_ catlist)
-{
-  if (catlist.max != 0)
-    malloc_kill_ks (malloc_pool_image (), catlist.exprs,
-		    catlist.max * sizeof (catlist.exprs[0]));
-}
-
-/* Make list of concatenated string exprs.
-
-   Returns a flattened list of concatenated subexpressions given a
-   tree of such expressions.  */
-
-static ffecomConcatList_
-ffecom_concat_list_new_ (ffebld expr, ffetargetCharacterSize max)
-{
-  ffecomConcatList_ catlist;
-
-  catlist.maxlen = catlist.minlen = catlist.max = catlist.count = 0;
-  return ffecom_concat_list_gather_ (catlist, expr, max);
-}
-
-/* Provide some kind of useful info on member of aggregate area,
-   since current g77/gcc technology does not provide debug info
-   on these members.  */
-
-static void
-ffecom_debug_kludge_ (tree aggr, const char *aggr_type, ffesymbol member,
-		      tree member_type UNUSED, ffetargetOffset offset)
-{
-  tree value;
-  tree decl;
-  int len;
-  char *buff;
-  char space[120];
-#if 0
-  tree type_id;
-
-  for (type_id = member_type;
-       TREE_CODE (type_id) != IDENTIFIER_NODE;
-       )
-    {
-      switch (TREE_CODE (type_id))
-	{
-	case INTEGER_TYPE:
-	case REAL_TYPE:
-	  type_id = TYPE_NAME (type_id);
-	  break;
-
-	case ARRAY_TYPE:
-	case COMPLEX_TYPE:
-	  type_id = TREE_TYPE (type_id);
-	  break;
-
-	default:
-	  assert ("no IDENTIFIER_NODE for type!" == NULL);
-	  type_id = error_mark_node;
-	  break;
-	}
-    }
-#endif
-
-  if (ffecom_transform_only_dummies_
-      || !ffe_is_debug_kludge ())
-    return;	/* Can't do this yet, maybe later. */
-
-  len = 60
-    + strlen (aggr_type)
-    + IDENTIFIER_LENGTH (DECL_NAME (aggr));
-#if 0
-    + IDENTIFIER_LENGTH (type_id);
-#endif
-
-  if (((size_t) len) >= ARRAY_SIZE (space))
-    buff = malloc_new_ks (malloc_pool_image (), "debug_kludge", len + 1);
-  else
-    buff = &space[0];
-
-  sprintf (&buff[0], "At (%s) `%s' plus %ld bytes",
-	   aggr_type,
-	   IDENTIFIER_POINTER (DECL_NAME (aggr)),
-	   (long int) offset);
-
-  value = build_string (len, buff);
-  TREE_TYPE (value)
-    = build_type_variant (build_array_type (char_type_node,
-					    build_range_type
-					    (integer_type_node,
-					     integer_one_node,
-					     build_int_2 (strlen (buff), 0))),
-			  1, 0);
-  decl = build_decl (VAR_DECL,
-		     ffecom_get_identifier_ (ffesymbol_text (member)),
-		     TREE_TYPE (value));
-  TREE_CONSTANT (decl) = 1;
-  TREE_STATIC (decl) = 1;
-  DECL_INITIAL (decl) = error_mark_node;
-  DECL_IN_SYSTEM_HEADER (decl) = 1;	/* Don't let -Wunused complain. */
-  decl = start_decl (decl, FALSE);
-  finish_decl (decl, value, FALSE);
-
-  if (buff != &space[0])
-    malloc_kill_ks (malloc_pool_image (), buff, len + 1);
-}
-
-/* ffecom_do_entry_ -- Do compilation of a particular entrypoint
-
-   ffesymbol fn;  // the SUBROUTINE, FUNCTION, or ENTRY symbol itself
-   int i;  // entry# for this entrypoint (used by master fn)
-   ffecom_do_entrypoint_(s,i);
-
-   Makes a public entry point that calls our private master fn (already
-   compiled).  */
-
-static void
-ffecom_do_entry_ (ffesymbol fn, int entrynum)
-{
-  ffebld item;
-  tree type;			/* Type of function. */
-  tree multi_retval;		/* Var holding return value (union). */
-  tree result;			/* Var holding result. */
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffeglobal g;
-  ffeglobalType gt;
-  bool charfunc;		/* All entry points return same type
-				   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. */
-  location_t old_loc = input_location;
-
-  input_filename = ffesymbol_where_filename (fn);
-  input_line = ffesymbol_where_filelinenum (fn);
-
-  ffecom_doing_entry_ = TRUE;	/* Don't bother with array dimensions. */
-
-  switch (ffecom_primary_entry_kind_)
-    {
-    case FFEINFO_kindFUNCTION:
-
-      /* Determine actual return type for function. */
-
-      gt = FFEGLOBAL_typeFUNC;
-      bt = ffesymbol_basictype (fn);
-      kt = ffesymbol_kindtype (fn);
-      if (bt == FFEINFO_basictypeNONE)
-	{
-	  ffeimplic_establish_symbol (fn);
-	  if (ffesymbol_funcresult (fn) != NULL)
-	    ffeimplic_establish_symbol (ffesymbol_funcresult (fn));
-	  bt = ffesymbol_basictype (fn);
-	  kt = ffesymbol_kindtype (fn);
-	}
-
-      if (bt == FFEINFO_basictypeCHARACTER)
-	charfunc = TRUE, cmplxfunc = FALSE;
-      else if ((bt == FFEINFO_basictypeCOMPLEX)
-	       && ffesymbol_is_f2c (fn))
-	charfunc = FALSE, cmplxfunc = TRUE;
-      else
-	charfunc = cmplxfunc = FALSE;
-
-      if (charfunc)
-	type = ffecom_tree_fun_type_void;
-      else if (ffesymbol_is_f2c (fn))
-	type = ffecom_tree_fun_type[bt][kt];
-      else
-	type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
-
-      if ((type == NULL_TREE)
-	  || (TREE_TYPE (type) == NULL_TREE))
-	type = ffecom_tree_fun_type_void;	/* _sym_exec_transition. */
-
-      multi = (ffecom_master_bt_ == FFEINFO_basictypeNONE);
-      break;
-
-    case FFEINFO_kindSUBROUTINE:
-      gt = FFEGLOBAL_typeSUBR;
-      bt = FFEINFO_basictypeNONE;
-      kt = FFEINFO_kindtypeNONE;
-      if (ffecom_is_altreturning_)
-	{			/* Am _I_ altreturning? */
-	  for (item = ffesymbol_dummyargs (fn);
-	       item != NULL;
-	       item = ffebld_trail (item))
-	    {
-	      if (ffebld_op (ffebld_head (item)) == FFEBLD_opSTAR)
-		{
-		  altreturning = TRUE;
-		  break;
-		}
-	    }
-	  if (altreturning)
-	    type = ffecom_tree_subr_type;
-	  else
-	    type = ffecom_tree_fun_type_void;
-	}
-      else
-	type = ffecom_tree_fun_type_void;
-      charfunc = FALSE;
-      cmplxfunc = FALSE;
-      multi = FALSE;
-      break;
-
-    default:
-      assert ("say what??" == NULL);
-      /* Fall through. */
-    case FFEINFO_kindANY:
-      gt = FFEGLOBAL_typeANY;
-      bt = FFEINFO_basictypeNONE;
-      kt = FFEINFO_kindtypeNONE;
-      type = error_mark_node;
-      charfunc = FALSE;
-      cmplxfunc = FALSE;
-      multi = FALSE;
-      break;
-    }
-
-  /* build_decl uses the current lineno and input_filename to set the decl
-     source info.  So, I've putzed with ffestd and ffeste code to update that
-     source info to point to the appropriate statement just before calling
-     ffecom_do_entrypoint (which calls this fn).  */
-
-  start_function (ffecom_get_external_identifier_ (fn),
-		  type,
-		  0,		/* nested/inline */
-		  1);		/* TREE_PUBLIC */
-
-  if (((g = ffesymbol_global (fn)) != NULL)
-      && ((ffeglobal_type (g) == gt)
-	  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
-    {
-      ffeglobal_set_hook (g, current_function_decl);
-    }
-
-  /* Reset args in master arg list so they get retransitioned. */
-
-  for (item = ffecom_master_arglist_;
-       item != NULL;
-       item = ffebld_trail (item))
-    {
-      ffebld arg;
-      ffesymbol s;
-
-      arg = ffebld_head (item);
-      if (ffebld_op (arg) != FFEBLD_opSYMTER)
-	continue;		/* Alternate return or some such thing. */
-      s = ffebld_symter (arg);
-      ffesymbol_hook (s).decl_tree = NULL_TREE;
-      ffesymbol_hook (s).length_tree = NULL_TREE;
-    }
-
-  /* Build dummy arg list for this entry point. */
-
-  if (charfunc || cmplxfunc)
-    {				/* Prepend arg for where result goes. */
-      tree type;
-      tree length;
-
-      if (charfunc)
-	type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
-      else
-	type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
-
-      result = ffecom_get_invented_identifier ("__g77_%s", "result");
-
-      /* Make length arg _and_ enhance type info for CHAR arg itself.  */
-
-      if (charfunc)
-	length = ffecom_char_enhance_arg_ (&type, fn);
-      else
-	length = NULL_TREE;	/* Not ref'd if !charfunc. */
-
-      type = build_pointer_type (type);
-      result = build_decl (PARM_DECL, result, type);
-
-      push_parm_decl (result);
-      ffecom_func_result_ = result;
-
-      if (charfunc)
-	{
-	  push_parm_decl (length);
-	  ffecom_func_length_ = length;
-	}
-    }
-  else
-    result = DECL_RESULT (current_function_decl);
-
-  ffecom_push_dummy_decls_ (ffesymbol_dummyargs (fn), FALSE);
-
-  store_parm_decls (0);
-
-  ffecom_start_compstmt ();
-  /* Disallow temp vars at this level.  */
-  current_binding_level->prep_state = 2;
-
-  /* Make local var to hold return type for multi-type master fn. */
-
-  if (multi)
-    {
-      multi_retval = ffecom_get_invented_identifier ("__g77_%s",
-						     "multi_retval");
-      multi_retval = build_decl (VAR_DECL, multi_retval,
-				 ffecom_multi_type_node_);
-      multi_retval = start_decl (multi_retval, FALSE);
-      finish_decl (multi_retval, NULL_TREE, FALSE);
-    }
-  else
-    multi_retval = NULL_TREE;	/* Not actually ref'd if !multi. */
-
-  /* Here we emit the actual code for the entry point. */
-
-  {
-    ffebld list;
-    ffebld arg;
-    ffesymbol s;
-    tree arglist = NULL_TREE;
-    tree *plist = &arglist;
-    tree prepend;
-    tree call;
-    tree actarg;
-    tree master_fn;
-
-    /* Prepare actual arg list based on master arg list. */
-
-    for (list = ffecom_master_arglist_;
-	 list != NULL;
-	 list = ffebld_trail (list))
-      {
-	arg = ffebld_head (list);
-	if (ffebld_op (arg) != FFEBLD_opSYMTER)
-	  continue;
-	s = ffebld_symter (arg);
-	if (ffesymbol_hook (s).decl_tree == NULL_TREE
-	    || ffesymbol_hook (s).decl_tree == error_mark_node)
-	  actarg = null_pointer_node;	/* We don't have this arg. */
-	else
-	  actarg = ffesymbol_hook (s).decl_tree;
-	*plist = build_tree_list (NULL_TREE, actarg);
-	plist = &TREE_CHAIN (*plist);
-      }
-
-    /* This code appends the length arguments for character
-       variables/arrays.  */
-
-    for (list = ffecom_master_arglist_;
-	 list != NULL;
-	 list = ffebld_trail (list))
-      {
-	arg = ffebld_head (list);
-	if (ffebld_op (arg) != FFEBLD_opSYMTER)
-	  continue;
-	s = ffebld_symter (arg);
-	if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)
-	  continue;		/* Only looking for CHARACTER arguments. */
-	if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
-	  continue;		/* Only looking for variables and arrays. */
-	if (ffesymbol_hook (s).length_tree == NULL_TREE
-	    || ffesymbol_hook (s).length_tree == error_mark_node)
-	  actarg = ffecom_f2c_ftnlen_zero_node;	/* We don't have this arg. */
-	else
-	  actarg = ffesymbol_hook (s).length_tree;
-	*plist = build_tree_list (NULL_TREE, actarg);
-	plist = &TREE_CHAIN (*plist);
-      }
-
-    /* Prepend character-value return info to actual arg list. */
-
-    if (charfunc)
-      {
-	prepend = build_tree_list (NULL_TREE, ffecom_func_result_);
-	TREE_CHAIN (prepend)
-	  = build_tree_list (NULL_TREE, ffecom_func_length_);
-	TREE_CHAIN (TREE_CHAIN (prepend)) = arglist;
-	arglist = prepend;
-      }
-
-    /* Prepend multi-type return value to actual arg list. */
-
-    if (multi)
-      {
-	prepend
-	  = build_tree_list (NULL_TREE,
-			     ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (multi_retval)),
-				       multi_retval));
-	TREE_CHAIN (prepend) = arglist;
-	arglist = prepend;
-      }
-
-    /* Prepend my entry-point number to the actual arg list. */
-
-    prepend = build_tree_list (NULL_TREE, build_int_2 (entrynum, 0));
-    TREE_CHAIN (prepend) = arglist;
-    arglist = prepend;
-
-    /* Build the call to the master function. */
-
-    master_fn = ffecom_1_fn (ffecom_previous_function_decl_);
-    call = ffecom_3s (CALL_EXPR,
-		      TREE_TYPE (TREE_TYPE (TREE_TYPE (master_fn))),
-		      master_fn, arglist, NULL_TREE);
-
-    /* Decide whether the master function is a function or subroutine, and
-       handle the return value for my entry point. */
-
-    if (charfunc || ((ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)
-		     && !altreturning))
-      {
-	expand_expr_stmt (call);
-	expand_null_return ();
-      }
-    else if (multi && cmplxfunc)
-      {
-	expand_expr_stmt (call);
-	result
-	  = ffecom_1 (INDIRECT_REF,
-		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),
-		      result);
-	result = ffecom_modify (NULL_TREE, result,
-				ffecom_2 (COMPONENT_REF, TREE_TYPE (result),
-					  multi_retval,
-					  ffecom_multi_fields_[bt][kt]));
-	expand_expr_stmt (result);
-	expand_null_return ();
-      }
-    else if (multi)
-      {
-	expand_expr_stmt (call);
-	result
-	  = ffecom_modify (NULL_TREE, result,
-			   convert (TREE_TYPE (result),
-				    ffecom_2 (COMPONENT_REF,
-					      ffecom_tree_type[bt][kt],
-					      multi_retval,
-					      ffecom_multi_fields_[bt][kt])));
-	expand_return (result);
-      }
-    else if (cmplxfunc)
-      {
-	result
-	  = ffecom_1 (INDIRECT_REF,
-		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (result))),
-		      result);
-	result = ffecom_modify (NULL_TREE, result, call);
-	expand_expr_stmt (result);
-	expand_null_return ();
-      }
-    else
-      {
-	result = ffecom_modify (NULL_TREE,
-				result,
-				convert (TREE_TYPE (result),
-					 call));
-	expand_return (result);
-      }
-  }
-
-  ffecom_end_compstmt ();
-
-  finish_function (0);
-
-  input_location = old_loc;
-
-  ffecom_doing_entry_ = FALSE;
-}
-
-/* Transform expr into gcc tree with possible destination
-
-   Recursive descent on expr while making corresponding tree nodes and
-   attaching type info and such.  If destination supplied and compatible
-   with temporary that would be made in certain cases, temporary isn't
-   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)
-{
-  tree item;
-  tree list;
-  tree args;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  tree t;
-  tree dt;			/* decl_tree for an ffesymbol. */
-  tree tree_type, tree_type_x;
-  tree left, right;
-  ffesymbol s;
-  enum tree_code code;
-
-  assert (expr != NULL);
-
-  if (dest_used != NULL)
-    *dest_used = FALSE;
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-  tree_type = ffecom_tree_type[bt][kt];
-
-  /* Widen integral arithmetic as desired while preserving signedness.  */
-  tree_type_x = NULL_TREE;
-  if (widenp && tree_type
-      && GET_MODE_CLASS (TYPE_MODE (tree_type)) == MODE_INT
-      && TYPE_PRECISION (tree_type) < TYPE_PRECISION (sizetype))
-    tree_type_x = (TYPE_UNSIGNED (tree_type) ? usizetype : ssizetype);
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opACCTER:
-      {
-	ffebitCount i;
-	ffebit bits = ffebld_accter_bits (expr);
-	ffetargetOffset source_offset = 0;
-	ffetargetOffset dest_offset = ffebld_accter_pad (expr);
-	tree purpose;
-
-	assert (dest_offset == 0
-		|| (bt == FFEINFO_basictypeCHARACTER
-		    && kt == FFEINFO_kindtypeCHARACTER1));
-
-	list = item = NULL;
-	for (;;)
-	  {
-	    ffebldConstantUnion cu;
-	    ffebitCount length;
-	    bool value;
-	    ffebldConstantArray ca = ffebld_accter (expr);
-
-	    ffebit_test (bits, source_offset, &value, &length);
-	    if (length == 0)
-	      break;
-
-	    if (value)
-	      {
-		for (i = 0; i < length; ++i)
-		  {
-		    cu = ffebld_constantarray_get (ca, bt, kt,
-						   source_offset + i);
-
-		    t = ffecom_constantunion (&cu, bt, kt, tree_type);
-
-		    if (i == 0
-			&& dest_offset != 0)
-		      purpose = build_int_2 (dest_offset, 0);
-		    else
-		      purpose = NULL_TREE;
-
-		    if (list == NULL_TREE)
-		      list = item = build_tree_list (purpose, t);
-		    else
-		      {
-			TREE_CHAIN (item) = build_tree_list (purpose, t);
-			item = TREE_CHAIN (item);
-		      }
-		  }
-	      }
-	    source_offset += length;
-	    dest_offset += length;
-	  }
-      }
-
-      item = build_int_2 ((ffebld_accter_size (expr)
-			   + ffebld_accter_pad (expr)) - 1, 0);
-      ffebit_kill (ffebld_accter_bits (expr));
-      TREE_TYPE (item) = ffecom_integer_type_node;
-      item
-	= build_array_type
-	  (tree_type,
-	   build_range_type (ffecom_integer_type_node,
-			     ffecom_integer_zero_node,
-			     item));
-      list = build_constructor (item, list);
-      TREE_CONSTANT (list) = 1;
-      TREE_STATIC (list) = 1;
-      return list;
-
-    case FFEBLD_opARRTER:
-      {
-	ffetargetOffset i;
-
-	list = NULL_TREE;
-	if (ffebld_arrter_pad (expr) == 0)
-	  item = NULL_TREE;
-	else
-	  {
-	    assert (bt == FFEINFO_basictypeCHARACTER
-		    && kt == FFEINFO_kindtypeCHARACTER1);
-
-	    /* Becomes PURPOSE first time through loop.  */
-	    item = build_int_2 (ffebld_arrter_pad (expr), 0);
-	  }
-
-	for (i = 0; i < ffebld_arrter_size (expr); ++i)
-	  {
-	    ffebldConstantUnion cu
-	    = ffebld_constantarray_get (ffebld_arrter (expr), bt, kt, i);
-
-	    t = ffecom_constantunion (&cu, bt, kt, tree_type);
-
-	    if (list == NULL_TREE)
-	      /* Assume item is PURPOSE first time through loop.  */
-	      list = item = build_tree_list (item, t);
-	    else
-	      {
-		TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
-		item = TREE_CHAIN (item);
-	      }
-	  }
-      }
-
-      item = build_int_2 ((ffebld_arrter_size (expr)
-			  + ffebld_arrter_pad (expr)) - 1, 0);
-      TREE_TYPE (item) = ffecom_integer_type_node;
-      item
-	= build_array_type
-	  (tree_type,
-	   build_range_type (ffecom_integer_type_node,
-			     ffecom_integer_zero_node,
-			     item));
-      list = build_constructor (item, list);
-      TREE_CONSTANT (list) = 1;
-      TREE_STATIC (list) = 1;
-      return list;
-
-    case FFEBLD_opCONTER:
-      assert (ffebld_conter_pad (expr) == 0);
-      item
-	= ffecom_constantunion (&ffebld_constant_union (ffebld_conter (expr)),
-				bt, kt, tree_type);
-      return item;
-
-    case FFEBLD_opSYMTER:
-      if ((ffebld_symter_generic (expr) != FFEINTRIN_genNONE)
-	  || (ffebld_symter_specific (expr) != FFEINTRIN_specNONE))
-	return ffecom_ptr_to_expr (expr);	/* Same as %REF(intrinsic). */
-      s = ffebld_symter (expr);
-      t = ffesymbol_hook (s).decl_tree;
-
-      if (assignp)
-	{			/* ASSIGN'ed-label expr. */
-	  if (ffe_is_ugly_assign ())
-	    {
-	      /* User explicitly wants ASSIGN'ed variables to be at the same
-		 memory address as the variables when used in non-ASSIGN
-		 contexts.  That can make old, arcane, non-standard code
-		 work, but don't try to do it when a pointer wouldn't fit
-		 in the normal variable (take other approach, and warn,
-		 instead).  */
-
-	      if (t == NULL_TREE)
-		{
-		  s = ffecom_sym_transform_ (s);
-		  t = ffesymbol_hook (s).decl_tree;
-		  assert (t != NULL_TREE);
-		}
-
-	      if (t == error_mark_node)
-		return t;
-
-	      if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (t)))
-		  >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
-		{
-		  if (ffesymbol_hook (s).addr)
-		    t = ffecom_1 (INDIRECT_REF,
-				  TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t);
-		  return t;
-		}
-
-	      if (ffesymbol_hook (s).assign_tree == NULL_TREE)
-		{
-		  /* xgettext:no-c-format */
-		  ffebad_start_msg ("ASSIGN'ed label cannot fit into `%A' at %0 -- using wider sibling",
-				    FFEBAD_severityWARNING);
-		  ffebad_string (ffesymbol_text (s));
-		  ffebad_here (0, ffesymbol_where_line (s),
-			       ffesymbol_where_column (s));
-		  ffebad_finish ();
-		}
-	    }
-
-	  /* Don't use the normal variable's tree for ASSIGN, though mark
-	     it as in the system header (housekeeping).  Use an explicit,
-	     specially created sibling that is known to be wide enough
-	     to hold pointers to labels.  */
-
-	  if (t != NULL_TREE
-	      && TREE_CODE (t) == VAR_DECL)
-	    DECL_IN_SYSTEM_HEADER (t) = 1;	/* Don't let -Wunused complain. */
-
-	  t = ffesymbol_hook (s).assign_tree;
-	  if (t == NULL_TREE)
-	    {
-	      s = ffecom_sym_transform_assign_ (s);
-	      t = ffesymbol_hook (s).assign_tree;
-	      assert (t != NULL_TREE);
-	    }
-	}
-      else
-	{
-	  if (t == NULL_TREE)
-	    {
-	      s = ffecom_sym_transform_ (s);
-	      t = ffesymbol_hook (s).decl_tree;
-	      assert (t != NULL_TREE);
-	    }
-	  if (ffesymbol_hook (s).addr)
-	    t = ffecom_1 (INDIRECT_REF,
-			  TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (t))), t);
-	}
-      return t;
-
-    case FFEBLD_opARRAYREF:
-      return ffecom_arrayref_ (NULL_TREE, expr, 0);
-
-    case FFEBLD_opUPLUS:
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      return ffecom_1 (NOP_EXPR, tree_type, left);
-
-    case FFEBLD_opPAREN:
-      /* ~~~Make sure Fortran rules respected here */
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      return ffecom_1 (NOP_EXPR, tree_type, left);
-
-    case FFEBLD_opUMINUS:
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      if (tree_type_x)
-	{
-	  tree_type = tree_type_x;
-	  left = convert (tree_type, left);
-	}
-      return ffecom_1 (NEGATE_EXPR, tree_type, left);
-
-    case FFEBLD_opADD:
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
-      if (tree_type_x)
-	{
-	  tree_type = tree_type_x;
-	  left = convert (tree_type, left);
-	  right = convert (tree_type, right);
-	}
-      return ffecom_2 (PLUS_EXPR, tree_type, left, right);
-
-    case FFEBLD_opSUBTRACT:
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
-      if (tree_type_x)
-	{
-	  tree_type = tree_type_x;
-	  left = convert (tree_type, left);
-	  right = convert (tree_type, right);
-	}
-      return ffecom_2 (MINUS_EXPR, tree_type, left, right);
-
-    case FFEBLD_opMULTIPLY:
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
-      if (tree_type_x)
-	{
-	  tree_type = tree_type_x;
-	  left = convert (tree_type, left);
-	  right = convert (tree_type, right);
-	}
-      return ffecom_2 (MULT_EXPR, tree_type, left, right);
-
-    case FFEBLD_opDIVIDE:
-      left = ffecom_expr_ (ffebld_left (expr), NULL, NULL, NULL, FALSE, widenp);
-      right = ffecom_expr_ (ffebld_right (expr), NULL, NULL, NULL, FALSE, widenp);
-      if (tree_type_x)
-	{
-	  tree_type = tree_type_x;
-	  left = convert (tree_type, left);
-	  right = convert (tree_type, right);
-	}
-      return ffecom_tree_divide_ (tree_type, left, right,
-			          dest_tree, dest, dest_used,
-				  ffebld_nonter_hook (expr));
-
-    case FFEBLD_opPOWER:
-      {
-	ffebld left = ffebld_left (expr);
-	ffebld right = ffebld_right (expr);
-	ffecomGfrt code;
-	ffeinfoKindtype rtkt;
-	ffeinfoKindtype ltkt;
-	bool ref = TRUE;
-
-	switch (ffeinfo_basictype (ffebld_info (right)))
-	  {
-
-	  case FFEINFO_basictypeINTEGER:
-	    if (1 || optimize)
-	      {
-		item = ffecom_expr_power_integer_ (expr);
-		if (item != NULL_TREE)
-		  return item;
-	      }
-
-	    rtkt = FFEINFO_kindtypeINTEGER1;
-	    switch (ffeinfo_basictype (ffebld_info (left)))
-	      {
-	      case FFEINFO_basictypeINTEGER:
-		if ((ffeinfo_kindtype (ffebld_info (left))
-		    == FFEINFO_kindtypeINTEGER4)
-		    || (ffeinfo_kindtype (ffebld_info (right))
-			== FFEINFO_kindtypeINTEGER4))
-		  {
-		    code = FFECOM_gfrtPOW_QQ;
-		    ltkt = FFEINFO_kindtypeINTEGER4;
-		    rtkt = FFEINFO_kindtypeINTEGER4;
-		  }
-		else
-		  {
-		    code = FFECOM_gfrtPOW_II;
-		    ltkt = FFEINFO_kindtypeINTEGER1;
-		  }
-		break;
-
-	      case FFEINFO_basictypeREAL:
-		if (ffeinfo_kindtype (ffebld_info (left))
-		    == FFEINFO_kindtypeREAL1)
-		  {
-		    code = FFECOM_gfrtPOW_RI;
-		    ltkt = FFEINFO_kindtypeREAL1;
-		  }
-		else
-		  {
-		    code = FFECOM_gfrtPOW_DI;
-		    ltkt = FFEINFO_kindtypeREAL2;
-		  }
-		break;
-
-	      case FFEINFO_basictypeCOMPLEX:
-		if (ffeinfo_kindtype (ffebld_info (left))
-		    == FFEINFO_kindtypeREAL1)
-		  {
-		    code = FFECOM_gfrtPOW_CI;	/* Overlapping result okay. */
-		    ltkt = FFEINFO_kindtypeREAL1;
-		  }
-		else
-		  {
-		    code = FFECOM_gfrtPOW_ZI;	/* Overlapping result okay. */
-		    ltkt = FFEINFO_kindtypeREAL2;
-		  }
-		break;
-
-	      default:
-		assert ("bad pow_*i" == NULL);
-		code = FFECOM_gfrtPOW_CI;	/* Overlapping result okay. */
-		ltkt = FFEINFO_kindtypeREAL1;
-		break;
-	      }
-	    if (ffeinfo_kindtype (ffebld_info (left)) != ltkt)
-	      left = ffeexpr_convert (left, NULL, NULL,
-				      ffeinfo_basictype (ffebld_info (left)),
-				      ltkt, 0,
-				      FFETARGET_charactersizeNONE,
-				      FFEEXPR_contextLET);
-	    if (ffeinfo_kindtype (ffebld_info (right)) != rtkt)
-	      right = ffeexpr_convert (right, NULL, NULL,
-				       FFEINFO_basictypeINTEGER,
-				       rtkt, 0,
-				       FFETARGET_charactersizeNONE,
-				       FFEEXPR_contextLET);
-	    break;
-
-	  case FFEINFO_basictypeREAL:
-	    if (ffeinfo_kindtype (ffebld_info (left)) == FFEINFO_kindtypeREAL1)
-	      left = ffeexpr_convert (left, NULL, NULL, FFEINFO_basictypeREAL,
-				      FFEINFO_kindtypeREALDOUBLE, 0,
-				      FFETARGET_charactersizeNONE,
-				      FFEEXPR_contextLET);
-	    if (ffeinfo_kindtype (ffebld_info (right))
-		== FFEINFO_kindtypeREAL1)
-	      right = ffeexpr_convert (right, NULL, NULL,
-				       FFEINFO_basictypeREAL,
-				       FFEINFO_kindtypeREALDOUBLE, 0,
-				       FFETARGET_charactersizeNONE,
-				       FFEEXPR_contextLET);
-	    /* We used to call FFECOM_gfrtPOW_DD here,
-	       which passes arguments by reference.  */
-	    code = FFECOM_gfrtL_POW;
-	    /* Pass arguments by value. */
-	    ref  = FALSE;
-	    break;
-
-	  case FFEINFO_basictypeCOMPLEX:
-	    if (ffeinfo_kindtype (ffebld_info (left)) == FFEINFO_kindtypeREAL1)
-	      left = ffeexpr_convert (left, NULL, NULL,
-				      FFEINFO_basictypeCOMPLEX,
-				      FFEINFO_kindtypeREALDOUBLE, 0,
-				      FFETARGET_charactersizeNONE,
-				      FFEEXPR_contextLET);
-	    if (ffeinfo_kindtype (ffebld_info (right))
-		== FFEINFO_kindtypeREAL1)
-	      right = ffeexpr_convert (right, NULL, NULL,
-				       FFEINFO_basictypeCOMPLEX,
-				       FFEINFO_kindtypeREALDOUBLE, 0,
-				       FFETARGET_charactersizeNONE,
-				       FFEEXPR_contextLET);
-	    code = FFECOM_gfrtPOW_ZZ;	/* Overlapping result okay. */
-	    ref = TRUE;			/* Pass arguments by reference. */
-	    break;
-
-	  default:
-	    assert ("bad pow_x*" == NULL);
-	    code = FFECOM_gfrtPOW_II;
-	    break;
-	  }
-	return ffecom_call_binop_ (ffecom_gfrt_tree_ (code),
-				   ffecom_gfrt_kindtype (code),
-				   (ffe_is_f2c_library ()
-				    && ffecom_gfrt_complex_[code]),
-				   tree_type, left, right,
-				   dest_tree, dest, dest_used,
-				   NULL_TREE, FALSE, ref,
-				   ffebld_nonter_hook (expr));
-      }
-
-    case FFEBLD_opNOT:
-      switch (bt)
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  item = ffecom_truth_value_invert (ffecom_expr (ffebld_left (expr)));
-	  return convert (tree_type, item);
-
-	case FFEINFO_basictypeINTEGER:
-	  return ffecom_1 (BIT_NOT_EXPR, tree_type,
-			   ffecom_expr (ffebld_left (expr)));
-
-	default:
-	  assert ("NOT bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opFUNCREF:
-      assert (ffeinfo_basictype (ffebld_info (expr))
-	      != FFEINFO_basictypeCHARACTER);
-      /* Fall through.	 */
-    case FFEBLD_opSUBRREF:
-      if (ffeinfo_where (ffebld_info (ffebld_left (expr)))
-	  == FFEINFO_whereINTRINSIC)
-	{			/* Invocation of an intrinsic. */
-	  item = ffecom_expr_intrinsic_ (expr, dest_tree, dest,
-					 dest_used);
-	  return item;
-	}
-      s = ffebld_symter (ffebld_left (expr));
-      dt = ffesymbol_hook (s).decl_tree;
-      if (dt == NULL_TREE)
-	{
-	  s = ffecom_sym_transform_ (s);
-	  dt = ffesymbol_hook (s).decl_tree;
-	}
-      if (dt == error_mark_node)
-	return dt;
-
-      if (ffesymbol_hook (s).addr)
-	item = dt;
-      else
-	item = ffecom_1_fn (dt);
-
-      if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
-	args = ffecom_list_expr (ffebld_right (expr));
-      else
-	args = ffecom_list_ptr_to_expr (ffebld_right (expr));
-
-      if (args == error_mark_node)
-	return error_mark_node;
-
-      item = ffecom_call_ (item, kt,
-			   ffesymbol_is_f2c (s)
-			   && (bt == FFEINFO_basictypeCOMPLEX)
-			   && (ffesymbol_where (s)
-			       != FFEINFO_whereCONSTANT),
-			   tree_type,
-			   args,
-			   dest_tree, dest, dest_used,
-			   error_mark_node, FALSE,
-			   ffebld_nonter_hook (expr));
-      TREE_SIDE_EFFECTS (item) = 1;
-      return item;
-
-    case FFEBLD_opAND:
-      switch (bt)
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  item
-	    = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
-		       ffecom_truth_value (ffecom_expr (ffebld_left (expr))),
-		     ffecom_truth_value (ffecom_expr (ffebld_right (expr))));
-	  return convert (tree_type, item);
-
-	case FFEINFO_basictypeINTEGER:
-	  return ffecom_2 (BIT_AND_EXPR, tree_type,
-			   ffecom_expr (ffebld_left (expr)),
-			   ffecom_expr (ffebld_right (expr)));
-
-	default:
-	  assert ("AND bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opOR:
-      switch (bt)
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  item
-	    = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
-		       ffecom_truth_value (ffecom_expr (ffebld_left (expr))),
-		     ffecom_truth_value (ffecom_expr (ffebld_right (expr))));
-	  return convert (tree_type, item);
-
-	case FFEINFO_basictypeINTEGER:
-	  return ffecom_2 (BIT_IOR_EXPR, tree_type,
-			   ffecom_expr (ffebld_left (expr)),
-			   ffecom_expr (ffebld_right (expr)));
-
-	default:
-	  assert ("OR bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opXOR:
-    case FFEBLD_opNEQV:
-      switch (bt)
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  item
-	    = ffecom_2 (NE_EXPR, integer_type_node,
-			ffecom_expr (ffebld_left (expr)),
-			ffecom_expr (ffebld_right (expr)));
-	  return convert (tree_type, ffecom_truth_value (item));
-
-	case FFEINFO_basictypeINTEGER:
-	  return ffecom_2 (BIT_XOR_EXPR, tree_type,
-			   ffecom_expr (ffebld_left (expr)),
-			   ffecom_expr (ffebld_right (expr)));
-
-	default:
-	  assert ("XOR/NEQV bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opEQV:
-      switch (bt)
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  item
-	    = ffecom_2 (EQ_EXPR, integer_type_node,
-			ffecom_expr (ffebld_left (expr)),
-			ffecom_expr (ffebld_right (expr)));
-	  return convert (tree_type, ffecom_truth_value (item));
-
-	case FFEINFO_basictypeINTEGER:
-	  return
-	    ffecom_1 (BIT_NOT_EXPR, tree_type,
-		      ffecom_2 (BIT_XOR_EXPR, tree_type,
-				ffecom_expr (ffebld_left (expr)),
-				ffecom_expr (ffebld_right (expr))));
-
-	default:
-	  assert ("EQV bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opCONVERT:
-      if (ffebld_op (ffebld_left (expr)) == FFEBLD_opANY)
-	return error_mark_node;
-
-      switch (bt)
-	{
-	case FFEINFO_basictypeLOGICAL:
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeREAL:
-	  return convert (tree_type, ffecom_expr (ffebld_left (expr)));
-
-	case FFEINFO_basictypeCOMPLEX:
-	  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	    case FFEINFO_basictypeLOGICAL:
-	    case FFEINFO_basictypeREAL:
-	      item = ffecom_expr (ffebld_left (expr));
-	      if (item == error_mark_node)
-		return error_mark_node;
-	      /* convert() takes care of converting to the subtype first,
-		 at least in gcc-2.7.2. */
-	      item = convert (tree_type, item);
-	      return item;
-
-	    case FFEINFO_basictypeCOMPLEX:
-	      return convert (tree_type, ffecom_expr (ffebld_left (expr)));
-
-	    default:
-	      assert ("CONVERT COMPLEX bad basictype" == NULL);
-	      /* Fall through. */
-	    case FFEINFO_basictypeANY:
-	      return error_mark_node;
-	    }
-	  break;
-
-	default:
-	  assert ("CONVERT bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opLT:
-      code = LT_EXPR;
-      goto relational;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opLE:
-      code = LE_EXPR;
-      goto relational;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opEQ:
-      code = EQ_EXPR;
-      goto relational;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opNE:
-      code = NE_EXPR;
-      goto relational;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opGT:
-      code = GT_EXPR;
-      goto relational;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opGE:
-      code = GE_EXPR;
-
-    relational:		/* :::::::::::::::::::: */
-      switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeREAL:
-	  item = ffecom_2 (code, integer_type_node,
-			   ffecom_expr (ffebld_left (expr)),
-			   ffecom_expr (ffebld_right (expr)));
-	  return convert (tree_type, item);
-
-	case FFEINFO_basictypeCOMPLEX:
-	  assert (code == EQ_EXPR || code == NE_EXPR);
-	  {
-	    tree real_type;
-	    tree arg1 = ffecom_expr (ffebld_left (expr));
-	    tree arg2 = ffecom_expr (ffebld_right (expr));
-
-	    if (arg1 == error_mark_node || arg2 == error_mark_node)
-	      return error_mark_node;
-
-	    arg1 = ffecom_save_tree (arg1);
-	    arg2 = ffecom_save_tree (arg2);
-
-	    if (TREE_CODE (TREE_TYPE (arg1)) == COMPLEX_TYPE)
-	      {
-		real_type = TREE_TYPE (TREE_TYPE (arg1));
-		assert (real_type == TREE_TYPE (TREE_TYPE (arg2)));
-	      }
-	    else
-	      {
-		real_type = TREE_TYPE (TYPE_FIELDS (TREE_TYPE (arg1)));
-		assert (real_type == TREE_TYPE (TYPE_FIELDS (TREE_TYPE (arg2))));
-	      }
-
-	    item
-	      = ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
-			  ffecom_2 (EQ_EXPR, integer_type_node,
-				  ffecom_1 (REALPART_EXPR, real_type, arg1),
-				 ffecom_1 (REALPART_EXPR, real_type, arg2)),
-			  ffecom_2 (EQ_EXPR, integer_type_node,
-				  ffecom_1 (IMAGPART_EXPR, real_type, arg1),
-				    ffecom_1 (IMAGPART_EXPR, real_type,
-					      arg2)));
-	    if (code == EQ_EXPR)
-	      item = ffecom_truth_value (item);
-	    else
-	      item = ffecom_truth_value_invert (item);
-	    return convert (tree_type, item);
-	  }
-
-	case FFEINFO_basictypeCHARACTER:
-	  {
-	    ffebld left = ffebld_left (expr);
-	    ffebld right = ffebld_right (expr);
-	    tree left_tree;
-	    tree right_tree;
-	    tree left_length;
-	    tree right_length;
-
-	    /* f2c run-time functions do the implicit blank-padding for us,
-	       so we don't usually have to implement blank-padding ourselves.
-	       (The exception is when we pass an argument to a separately
-	       compiled statement function -- if we know the arg is not the
-	       same length as the dummy, we must truncate or extend it.	 If
-	       we "inline" statement functions, that necessity goes away as
-	       well.)
-
-	       Strip off the CONVERT operators that blank-pad.  (Truncation by
-	       CONVERT shouldn't happen here, but it can happen in
-	       assignments.) */
-
-	    while (ffebld_op (left) == FFEBLD_opCONVERT)
-	      left = ffebld_left (left);
-	    while (ffebld_op (right) == FFEBLD_opCONVERT)
-	      right = ffebld_left (right);
-
-	    left_tree = ffecom_arg_ptr_to_expr (left, &left_length);
-	    right_tree = ffecom_arg_ptr_to_expr (right, &right_length);
-
-	    if (left_tree == error_mark_node || left_length == error_mark_node
-		|| right_tree == error_mark_node
-		|| right_length == error_mark_node)
-	      return error_mark_node;
-
-	    if ((ffebld_size_known (left) == 1)
-		&& (ffebld_size_known (right) == 1))
-	      {
-		left_tree
-		  = ffecom_1 (INDIRECT_REF,
-		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (left_tree))),
-			      left_tree);
-		right_tree
-		  = ffecom_1 (INDIRECT_REF,
-		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (right_tree))),
-			      right_tree);
-
-		item
-		  = ffecom_2 (code, integer_type_node,
-			      ffecom_2 (ARRAY_REF,
-		      TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (left_tree))),
-					left_tree,
-					integer_one_node),
-			      ffecom_2 (ARRAY_REF,
-		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (right_tree))),
-					right_tree,
-					integer_one_node));
-	      }
-	    else
-	      {
-		item = build_tree_list (NULL_TREE, left_tree);
-		TREE_CHAIN (item) = build_tree_list (NULL_TREE, right_tree);
-		TREE_CHAIN (TREE_CHAIN (item)) = build_tree_list (NULL_TREE,
-							       left_length);
-		TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))
-		  = build_tree_list (NULL_TREE, right_length);
-		item = ffecom_call_gfrt (FFECOM_gfrtCMP, item, NULL_TREE);
-		item = ffecom_2 (code, integer_type_node,
-				 item,
-				 convert (TREE_TYPE (item),
-					  integer_zero_node));
-	      }
-	    item = convert (tree_type, item);
-	  }
-
-	  return item;
-
-	default:
-	  assert ("relational bad basictype" == NULL);
-	  /* Fall through. */
-	case FFEINFO_basictypeANY:
-	  return error_mark_node;
-	}
-      break;
-
-    case FFEBLD_opPERCENT_LOC:
-      item = ffecom_arg_ptr_to_expr (ffebld_left (expr), &list);
-      return convert (tree_type, item);
-
-    case FFEBLD_opPERCENT_VAL:
-      item = ffecom_arg_expr (ffebld_left (expr), &list);
-      return convert (tree_type, item);
-
-    case FFEBLD_opITEM:
-    case FFEBLD_opSTAR:
-    case FFEBLD_opBOUNDS:
-    case FFEBLD_opREPEAT:
-    case FFEBLD_opLABTER:
-    case FFEBLD_opLABTOK:
-    case FFEBLD_opIMPDO:
-    case FFEBLD_opCONCATENATE:
-    case FFEBLD_opSUBSTR:
-    default:
-      assert ("bad op" == NULL);
-      /* Fall through. */
-    case FFEBLD_opANY:
-      return error_mark_node;
-    }
-
-#if 1
-  assert ("didn't think anything got here anymore!!" == NULL);
-#else
-  switch (ffebld_arity (expr))
-    {
-    case 2:
-      TREE_OPERAND (item, 0) = ffecom_expr (ffebld_left (expr));
-      TREE_OPERAND (item, 1) = ffecom_expr (ffebld_right (expr));
-      if (TREE_OPERAND (item, 0) == error_mark_node
-	  || TREE_OPERAND (item, 1) == error_mark_node)
-	return error_mark_node;
-      break;
-
-    case 1:
-      TREE_OPERAND (item, 0) = ffecom_expr (ffebld_left (expr));
-      if (TREE_OPERAND (item, 0) == error_mark_node)
-	return error_mark_node;
-      break;
-
-    default:
-      break;
-    }
-
-  return fold (item);
-#endif
-}
-
-/* Returns the tree that does the intrinsic invocation.
-
-   Note: this function applies only to intrinsics returning
-   CHARACTER*1 or non-CHARACTER results, and to intrinsic
-   subroutines.  */
-
-static tree
-ffecom_expr_intrinsic_ (ffebld expr, tree dest_tree, ffebld dest,
-			bool *dest_used)
-{
-  tree expr_tree;
-  tree saved_expr1;		/* For those who need it. */
-  tree saved_expr2;		/* For those who need it. */
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  tree tree_type;
-  tree arg1_type;
-  tree real_type;		/* REAL type corresponding to COMPLEX. */
-  tree tempvar;
-  ffebld list = ffebld_right (expr);	/* List of (some) args. */
-  ffebld arg1;			/* For handy reference. */
-  ffebld arg2;
-  ffebld arg3;
-  ffeintrinImp codegen_imp;
-  ffecomGfrt gfrt;
-
-  assert (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER);
-
-  if (dest_used != NULL)
-    *dest_used = FALSE;
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-  tree_type = ffecom_tree_type[bt][kt];
-
-  if (list != NULL)
-    {
-      arg1 = ffebld_head (list);
-      if (arg1 != NULL && ffebld_op (arg1) == FFEBLD_opANY)
-	return error_mark_node;
-      if ((list = ffebld_trail (list)) != NULL)
-	{
-	  arg2 = ffebld_head (list);
-	  if (arg2 != NULL && ffebld_op (arg2) == FFEBLD_opANY)
-	    return error_mark_node;
-	  if ((list = ffebld_trail (list)) != NULL)
-	    {
-	      arg3 = ffebld_head (list);
-	      if (arg3 != NULL && ffebld_op (arg3) == FFEBLD_opANY)
-		return error_mark_node;
-	    }
-	  else
-	    arg3 = NULL;
-	}
-      else
-	arg2 = arg3 = NULL;
-    }
-  else
-    arg1 = arg2 = arg3 = NULL;
-
-  /* <list> ends up at the opITEM of the 3rd arg, or NULL if there are < 3
-     args.  This is used by the MAX/MIN expansions. */
-
-  if (arg1 != NULL)
-    arg1_type = ffecom_tree_type
-      [ffeinfo_basictype (ffebld_info (arg1))]
-      [ffeinfo_kindtype (ffebld_info (arg1))];
-  else
-    arg1_type = NULL_TREE;	/* Really not needed, but might catch bugs
-				   here. */
-
-  /* There are several ways for each of the cases in the following switch
-     statements to exit (from simplest to use to most complicated):
-
-     break;  (when expr_tree == NULL)
-
-     A standard call is made to the specific intrinsic just as if it had been
-     passed in as a dummy procedure and called as any old procedure.  This
-     method can produce slower code but in some cases it's the easiest way for
-     now.  However, if a (presumably faster) direct call is available,
-     that is used, so this is the easiest way in many more cases now.
-
-     gfrt = FFECOM_gfrtWHATEVER;
-     break;
-
-     gfrt contains the gfrt index of a library function to call, passing the
-     argument(s) by value rather than by reference.  Used when a more
-     careful choice of library function is needed than that provided
-     by the vanilla `break;'.
-
-     return expr_tree;
-
-     The expr_tree has been completely set up and is ready to be returned
-     as is.  No further actions are taken.  Use this when the tree is not
-     in the simple form for one of the arity_n labels.	 */
-
-  /* For info on how the switch statement cases were written, see the files
-     enclosed in comments below the switch statement. */
-
-  codegen_imp = ffebld_symter_implementation (ffebld_left (expr));
-  gfrt = ffeintrin_gfrt_direct (codegen_imp);
-  if (gfrt == FFECOM_gfrt)
-    gfrt = ffeintrin_gfrt_indirect (codegen_imp);
-
-  switch (codegen_imp)
-    {
-    case FFEINTRIN_impABS:
-    case FFEINTRIN_impCABS:
-    case FFEINTRIN_impCDABS:
-    case FFEINTRIN_impDABS:
-    case FFEINTRIN_impIABS:
-      if (ffeinfo_basictype (ffebld_info (arg1))
-	  == FFEINFO_basictypeCOMPLEX)
-	{
-	  if (kt == FFEINFO_kindtypeREAL1)
-	    gfrt = FFECOM_gfrtCABS;
-	  else if (kt == FFEINFO_kindtypeREAL2)
-	    gfrt = FFECOM_gfrtCDABS;
-	  break;
-	}
-      return ffecom_1 (ABS_EXPR, tree_type,
-		       convert (tree_type, ffecom_expr (arg1)));
-
-    case FFEINTRIN_impACOS:
-    case FFEINTRIN_impDACOS:
-      break;
-
-    case FFEINTRIN_impAIMAG:
-    case FFEINTRIN_impDIMAG:
-    case FFEINTRIN_impIMAGPART:
-      if (TREE_CODE (arg1_type) == COMPLEX_TYPE)
-	arg1_type = TREE_TYPE (arg1_type);
-      else
-	arg1_type = TREE_TYPE (TYPE_FIELDS (arg1_type));
-
-      return
-	convert (tree_type,
-		 ffecom_1 (IMAGPART_EXPR, arg1_type,
-			   ffecom_expr (arg1)));
-
-    case FFEINTRIN_impAINT:
-    case FFEINTRIN_impDINT:
-#if 0
-      /* ~~Someday implement FIX_TRUNC_EXPR yielding same type as arg.  */
-      return ffecom_1 (FIX_TRUNC_EXPR, tree_type, ffecom_expr (arg1));
-#else /* in the meantime, must use floor to avoid range problems with ints */
-      /* r__1 = r1 >= 0 ? floor(r1) : -floor(-r1); */
-      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
-      return
-	convert (tree_type,
-		 ffecom_3 (COND_EXPR, double_type_node,
-			   ffecom_truth_value
-			   (ffecom_2 (GE_EXPR, integer_type_node,
-				      saved_expr1,
-				      convert (arg1_type,
-					       ffecom_float_zero_))),
-			   ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
-					     build_tree_list (NULL_TREE,
-						  convert (double_type_node,
-							   saved_expr1)),
-					     NULL_TREE),
-			   ffecom_1 (NEGATE_EXPR, double_type_node,
-				     ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
-						 build_tree_list (NULL_TREE,
-						  convert (double_type_node,
-						      ffecom_1 (NEGATE_EXPR,
-								arg1_type,
-							       saved_expr1))),
-						       NULL_TREE)
-				     ))
-		 );
-#endif
-
-    case FFEINTRIN_impANINT:
-    case FFEINTRIN_impDNINT:
-#if 0				/* This way of doing it won't handle real
-				   numbers of large magnitudes. */
-      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
-      expr_tree = convert (tree_type,
-			   convert (integer_type_node,
-				    ffecom_3 (COND_EXPR, tree_type,
-					      ffecom_truth_value
-					      (ffecom_2 (GE_EXPR,
-							 integer_type_node,
-							 saved_expr1,
-						       ffecom_float_zero_)),
-					      ffecom_2 (PLUS_EXPR,
-							tree_type,
-							saved_expr1,
-							ffecom_float_half_),
-					      ffecom_2 (MINUS_EXPR,
-							tree_type,
-							saved_expr1,
-						     ffecom_float_half_))));
-      return expr_tree;
-#else /* So we instead call floor. */
-      /* r__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1) */
-      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
-      return
-	convert (tree_type,
-		 ffecom_3 (COND_EXPR, double_type_node,
-			   ffecom_truth_value
-			   (ffecom_2 (GE_EXPR, integer_type_node,
-				      saved_expr1,
-				      convert (arg1_type,
-					       ffecom_float_zero_))),
-			   ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
-					     build_tree_list (NULL_TREE,
-						  convert (double_type_node,
-							   ffecom_2 (PLUS_EXPR,
-								     arg1_type,
-								     saved_expr1,
-								     convert (arg1_type,
-									      ffecom_float_half_)))),
-					     NULL_TREE),
-			   ffecom_1 (NEGATE_EXPR, double_type_node,
-				     ffecom_call_gfrt (FFECOM_gfrtL_FLOOR,
-						       build_tree_list (NULL_TREE,
-									convert (double_type_node,
-										 ffecom_2 (MINUS_EXPR,
-											   arg1_type,
-											   convert (arg1_type,
-												    ffecom_float_half_),
-											   saved_expr1))),
-						       NULL_TREE))
-			   )
-		 );
-#endif
-
-    case FFEINTRIN_impASIN:
-    case FFEINTRIN_impDASIN:
-    case FFEINTRIN_impATAN:
-    case FFEINTRIN_impDATAN:
-    case FFEINTRIN_impATAN2:
-    case FFEINTRIN_impDATAN2:
-      break;
-
-    case FFEINTRIN_impCHAR:
-    case FFEINTRIN_impACHAR:
-      tempvar = ffebld_nonter_hook (expr);
-      assert (tempvar);
-      {
-	tree tmv = TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (tempvar)));
-
-	expr_tree = ffecom_modify (tmv,
-				   ffecom_2 (ARRAY_REF, tmv, tempvar,
-					     integer_one_node),
-				   convert (tmv, ffecom_expr (arg1)));
-      }
-      expr_tree = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (tempvar),
-			    expr_tree,
-			    tempvar);
-      expr_tree = ffecom_1 (ADDR_EXPR,
-			    build_pointer_type (TREE_TYPE (expr_tree)),
-			    expr_tree);
-      return expr_tree;
-
-    case FFEINTRIN_impCMPLX:
-    case FFEINTRIN_impDCMPLX:
-      if (arg2 == NULL)
-	return
-	  convert (tree_type, ffecom_expr (arg1));
-
-      real_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
-      return
-	ffecom_2 (COMPLEX_EXPR, tree_type,
-		  convert (real_type, ffecom_expr (arg1)),
-		  convert (real_type,
-			   ffecom_expr (arg2)));
-
-    case FFEINTRIN_impCOMPLEX:
-      return
-	ffecom_2 (COMPLEX_EXPR, tree_type,
-		  ffecom_expr (arg1),
-		  ffecom_expr (arg2));
-
-    case FFEINTRIN_impCONJG:
-    case FFEINTRIN_impDCONJG:
-      {
-	tree arg1_tree;
-
-	real_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
-	arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
-	return
-	  ffecom_2 (COMPLEX_EXPR, tree_type,
-		    ffecom_1 (REALPART_EXPR, real_type, arg1_tree),
-		    ffecom_1 (NEGATE_EXPR, real_type,
-			      ffecom_1 (IMAGPART_EXPR, real_type, arg1_tree)));
-      }
-
-    case FFEINTRIN_impCOS:
-    case FFEINTRIN_impCCOS:
-    case FFEINTRIN_impCDCOS:
-    case FFEINTRIN_impDCOS:
-      if (bt == FFEINFO_basictypeCOMPLEX)
-	{
-	  if (kt == FFEINFO_kindtypeREAL1)
-	    gfrt = FFECOM_gfrtCCOS;	/* Overlapping result okay. */
-	  else if (kt == FFEINFO_kindtypeREAL2)
-	    gfrt = FFECOM_gfrtCDCOS;	/* Overlapping result okay. */
-	}
-      break;
-
-    case FFEINTRIN_impCOSH:
-    case FFEINTRIN_impDCOSH:
-      break;
-
-    case FFEINTRIN_impDBLE:
-    case FFEINTRIN_impDFLOAT:
-    case FFEINTRIN_impDREAL:
-    case FFEINTRIN_impFLOAT:
-    case FFEINTRIN_impIDINT:
-    case FFEINTRIN_impIFIX:
-    case FFEINTRIN_impINT2:
-    case FFEINTRIN_impINT8:
-    case FFEINTRIN_impINT:
-    case FFEINTRIN_impLONG:
-    case FFEINTRIN_impREAL:
-    case FFEINTRIN_impSHORT:
-    case FFEINTRIN_impSNGL:
-      return convert (tree_type, ffecom_expr (arg1));
-
-    case FFEINTRIN_impDIM:
-    case FFEINTRIN_impDDIM:
-    case FFEINTRIN_impIDIM:
-      saved_expr1 = ffecom_save_tree (convert (tree_type,
-					       ffecom_expr (arg1)));
-      saved_expr2 = ffecom_save_tree (convert (tree_type,
-					       ffecom_expr (arg2)));
-      return
-	ffecom_3 (COND_EXPR, tree_type,
-		  ffecom_truth_value
-		  (ffecom_2 (GT_EXPR, integer_type_node,
-			     saved_expr1,
-			     saved_expr2)),
-		  ffecom_2 (MINUS_EXPR, tree_type,
-			    saved_expr1,
-			    saved_expr2),
-		  convert (tree_type, ffecom_float_zero_));
-
-    case FFEINTRIN_impDPROD:
-      return
-	ffecom_2 (MULT_EXPR, tree_type,
-		  convert (tree_type, ffecom_expr (arg1)),
-		  convert (tree_type, ffecom_expr (arg2)));
-
-    case FFEINTRIN_impEXP:
-    case FFEINTRIN_impCDEXP:
-    case FFEINTRIN_impCEXP:
-    case FFEINTRIN_impDEXP:
-      if (bt == FFEINFO_basictypeCOMPLEX)
-	{
-	  if (kt == FFEINFO_kindtypeREAL1)
-	    gfrt = FFECOM_gfrtCEXP;	/* Overlapping result okay. */
-	  else if (kt == FFEINFO_kindtypeREAL2)
-	    gfrt = FFECOM_gfrtCDEXP;	/* Overlapping result okay. */
-	}
-      break;
-
-    case FFEINTRIN_impICHAR:
-    case FFEINTRIN_impIACHAR:
-#if 0				/* The simple approach. */
-      ffecom_char_args_ (&expr_tree, &saved_expr1 /* Ignored */ , arg1);
-      expr_tree
-	= ffecom_1 (INDIRECT_REF,
-		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
-		    expr_tree);
-      expr_tree
-	= ffecom_2 (ARRAY_REF,
-		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
-		    expr_tree,
-		    integer_one_node);
-      return convert (tree_type, expr_tree);
-#else /* The more interesting (and more optimal) approach. */
-      expr_tree = ffecom_intrinsic_ichar_ (tree_type, arg1, &saved_expr1);
-      expr_tree = ffecom_3 (COND_EXPR, tree_type,
-			    saved_expr1,
-			    expr_tree,
-			    convert (tree_type, integer_zero_node));
-      return expr_tree;
-#endif
-
-    case FFEINTRIN_impINDEX:
-      break;
-
-    case FFEINTRIN_impLEN:
-#if 0
-      break;					/* The simple approach. */
-#else
-      return ffecom_intrinsic_len_ (arg1);	/* The more optimal approach. */
-#endif
-
-    case FFEINTRIN_impLGE:
-    case FFEINTRIN_impLGT:
-    case FFEINTRIN_impLLE:
-    case FFEINTRIN_impLLT:
-      break;
-
-    case FFEINTRIN_impLOG:
-    case FFEINTRIN_impALOG:
-    case FFEINTRIN_impCDLOG:
-    case FFEINTRIN_impCLOG:
-    case FFEINTRIN_impDLOG:
-      if (bt == FFEINFO_basictypeCOMPLEX)
-	{
-	  if (kt == FFEINFO_kindtypeREAL1)
-	    gfrt = FFECOM_gfrtCLOG;	/* Overlapping result okay. */
-	  else if (kt == FFEINFO_kindtypeREAL2)
-	    gfrt = FFECOM_gfrtCDLOG;	/* Overlapping result okay. */
-	}
-      break;
-
-    case FFEINTRIN_impLOG10:
-    case FFEINTRIN_impALOG10:
-    case FFEINTRIN_impDLOG10:
-      if (gfrt != FFECOM_gfrt)
-	break;	/* Already picked one, stick with it. */
-
-      if (kt == FFEINFO_kindtypeREAL1)
-	/* We used to call FFECOM_gfrtALOG10 here.  */
-	gfrt = FFECOM_gfrtL_LOG10;
-      else if (kt == FFEINFO_kindtypeREAL2)
-	/* We used to call FFECOM_gfrtDLOG10 here.  */
-	gfrt = FFECOM_gfrtL_LOG10;
-      break;
-
-    case FFEINTRIN_impMAX:
-    case FFEINTRIN_impAMAX0:
-    case FFEINTRIN_impAMAX1:
-    case FFEINTRIN_impDMAX1:
-    case FFEINTRIN_impMAX0:
-    case FFEINTRIN_impMAX1:
-      if (bt != ffeinfo_basictype (ffebld_info (arg1)))
-	arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr));
-      else
-	arg1_type = tree_type;
-      expr_tree = ffecom_2 (MAX_EXPR, arg1_type,
-			    convert (arg1_type, ffecom_expr (arg1)),
-			    convert (arg1_type, ffecom_expr (arg2)));
-      for (; list != NULL; list = ffebld_trail (list))
-	{
-	  if ((ffebld_head (list) == NULL)
-	      || (ffebld_op (ffebld_head (list)) == FFEBLD_opANY))
-	    continue;
-	  expr_tree = ffecom_2 (MAX_EXPR, arg1_type,
-				expr_tree,
-				convert (arg1_type,
-					 ffecom_expr (ffebld_head (list))));
-	}
-      return convert (tree_type, expr_tree);
-
-    case FFEINTRIN_impMIN:
-    case FFEINTRIN_impAMIN0:
-    case FFEINTRIN_impAMIN1:
-    case FFEINTRIN_impDMIN1:
-    case FFEINTRIN_impMIN0:
-    case FFEINTRIN_impMIN1:
-      if (bt != ffeinfo_basictype (ffebld_info (arg1)))
-	arg1_type = ffecom_widest_expr_type_ (ffebld_right (expr));
-      else
-	arg1_type = tree_type;
-      expr_tree = ffecom_2 (MIN_EXPR, arg1_type,
-			    convert (arg1_type, ffecom_expr (arg1)),
-			    convert (arg1_type, ffecom_expr (arg2)));
-      for (; list != NULL; list = ffebld_trail (list))
-	{
-	  if ((ffebld_head (list) == NULL)
-	      || (ffebld_op (ffebld_head (list)) == FFEBLD_opANY))
-	    continue;
-	  expr_tree = ffecom_2 (MIN_EXPR, arg1_type,
-				expr_tree,
-				convert (arg1_type,
-					 ffecom_expr (ffebld_head (list))));
-	}
-      return convert (tree_type, expr_tree);
-
-    case FFEINTRIN_impMOD:
-    case FFEINTRIN_impAMOD:
-    case FFEINTRIN_impDMOD:
-      if (bt != FFEINFO_basictypeREAL)
-	return ffecom_2 (TRUNC_MOD_EXPR, tree_type,
-			 convert (tree_type, ffecom_expr (arg1)),
-			 convert (tree_type, ffecom_expr (arg2)));
-
-      if (kt == FFEINFO_kindtypeREAL1)
-	/* We used to call FFECOM_gfrtAMOD here.  */
-	gfrt = FFECOM_gfrtL_FMOD;
-      else if (kt == FFEINFO_kindtypeREAL2)
-	/* We used to call FFECOM_gfrtDMOD here.  */
-	gfrt = FFECOM_gfrtL_FMOD;
-      break;
-
-    case FFEINTRIN_impNINT:
-    case FFEINTRIN_impIDNINT:
-#if 0
-      /* ~~Ideally FIX_ROUND_EXPR would be implemented, but it ain't yet.  */
-      return ffecom_1 (FIX_ROUND_EXPR, tree_type, ffecom_expr (arg1));
-#else
-      /* i__1 = r1 >= 0 ? floor(r1 + .5) : -floor(.5 - r1); */
-      saved_expr1 = ffecom_save_tree (ffecom_expr (arg1));
-      return
-	convert (ffecom_integer_type_node,
-		 ffecom_3 (COND_EXPR, arg1_type,
-			   ffecom_truth_value
-			   (ffecom_2 (GE_EXPR, integer_type_node,
-				      saved_expr1,
-				      convert (arg1_type,
-					       ffecom_float_zero_))),
-			   ffecom_2 (PLUS_EXPR, arg1_type,
-				     saved_expr1,
-				     convert (arg1_type,
-					      ffecom_float_half_)),
-			   ffecom_2 (MINUS_EXPR, arg1_type,
-				     saved_expr1,
-				     convert (arg1_type,
-					      ffecom_float_half_))));
-#endif
-
-    case FFEINTRIN_impSIGN:
-    case FFEINTRIN_impDSIGN:
-    case FFEINTRIN_impISIGN:
-      {
-	tree arg2_tree = ffecom_expr (arg2);
-
-	saved_expr1
-	  = ffecom_save_tree
-	  (ffecom_1 (ABS_EXPR, tree_type,
-		     convert (tree_type,
-			      ffecom_expr (arg1))));
-	expr_tree
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (GE_EXPR, integer_type_node,
-				 arg2_tree,
-				 convert (TREE_TYPE (arg2_tree),
-					  integer_zero_node))),
-		      saved_expr1,
-		      ffecom_1 (NEGATE_EXPR, tree_type, saved_expr1));
-	/* Make sure SAVE_EXPRs get referenced early enough. */
-	expr_tree
-	  = ffecom_2 (COMPOUND_EXPR, tree_type,
-		      convert (void_type_node, saved_expr1),
-		      expr_tree);
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impSIN:
-    case FFEINTRIN_impCDSIN:
-    case FFEINTRIN_impCSIN:
-    case FFEINTRIN_impDSIN:
-      if (bt == FFEINFO_basictypeCOMPLEX)
-	{
-	  if (kt == FFEINFO_kindtypeREAL1)
-	    gfrt = FFECOM_gfrtCSIN;	/* Overlapping result okay. */
-	  else if (kt == FFEINFO_kindtypeREAL2)
-	    gfrt = FFECOM_gfrtCDSIN;	/* Overlapping result okay. */
-	}
-      break;
-
-    case FFEINTRIN_impSINH:
-    case FFEINTRIN_impDSINH:
-      break;
-
-    case FFEINTRIN_impSQRT:
-    case FFEINTRIN_impCDSQRT:
-    case FFEINTRIN_impCSQRT:
-    case FFEINTRIN_impDSQRT:
-      if (bt == FFEINFO_basictypeCOMPLEX)
-	{
-	  if (kt == FFEINFO_kindtypeREAL1)
-	    gfrt = FFECOM_gfrtCSQRT;	/* Overlapping result okay. */
-	  else if (kt == FFEINFO_kindtypeREAL2)
-	    gfrt = FFECOM_gfrtCDSQRT;	/* Overlapping result okay. */
-	}
-      break;
-
-    case FFEINTRIN_impTAN:
-    case FFEINTRIN_impDTAN:
-    case FFEINTRIN_impTANH:
-    case FFEINTRIN_impDTANH:
-      break;
-
-    case FFEINTRIN_impREALPART:
-      if (TREE_CODE (arg1_type) == COMPLEX_TYPE)
-	arg1_type = TREE_TYPE (arg1_type);
-      else
-	arg1_type = TREE_TYPE (TYPE_FIELDS (arg1_type));
-
-      return
-	convert (tree_type,
-		 ffecom_1 (REALPART_EXPR, arg1_type,
-			   ffecom_expr (arg1)));
-
-    case FFEINTRIN_impIAND:
-    case FFEINTRIN_impAND:
-      return ffecom_2 (BIT_AND_EXPR, tree_type,
-		       convert (tree_type,
-				ffecom_expr (arg1)),
-		       convert (tree_type,
-				ffecom_expr (arg2)));
-
-    case FFEINTRIN_impIOR:
-    case FFEINTRIN_impOR:
-      return ffecom_2 (BIT_IOR_EXPR, tree_type,
-		       convert (tree_type,
-				ffecom_expr (arg1)),
-		       convert (tree_type,
-				ffecom_expr (arg2)));
-
-    case FFEINTRIN_impIEOR:
-    case FFEINTRIN_impXOR:
-      return ffecom_2 (BIT_XOR_EXPR, tree_type,
-		       convert (tree_type,
-				ffecom_expr (arg1)),
-		       convert (tree_type,
-				ffecom_expr (arg2)));
-
-    case FFEINTRIN_impLSHIFT:
-      return ffecom_2 (LSHIFT_EXPR, tree_type,
-		       ffecom_expr (arg1),
-		       convert (integer_type_node,
-				ffecom_expr (arg2)));
-
-    case FFEINTRIN_impRSHIFT:
-      return ffecom_2 (RSHIFT_EXPR, tree_type,
-		       ffecom_expr (arg1),
-		       convert (integer_type_node,
-				ffecom_expr (arg2)));
-
-    case FFEINTRIN_impNOT:
-      return ffecom_1 (BIT_NOT_EXPR, tree_type, ffecom_expr (arg1));
-
-    case FFEINTRIN_impBIT_SIZE:
-      return convert (tree_type, TYPE_SIZE (arg1_type));
-
-    case FFEINTRIN_impBTEST:
-      {
-	ffetargetLogical1 target_true;
-	ffetargetLogical1 target_false;
-	tree true_tree;
-	tree false_tree;
-
-	ffetarget_logical1 (&target_true, TRUE);
-	ffetarget_logical1 (&target_false, FALSE);
-	if (target_true == 1)
-	  true_tree = convert (tree_type, integer_one_node);
-	else
-	  true_tree = convert (tree_type, build_int_2 (target_true, 0));
-	if (target_false == 0)
-	  false_tree = convert (tree_type, integer_zero_node);
-	else
-	  false_tree = convert (tree_type, build_int_2 (target_false, 0));
-
-	return
-	  ffecom_3 (COND_EXPR, tree_type,
-		    ffecom_truth_value
-		    (ffecom_2 (EQ_EXPR, integer_type_node,
-			       ffecom_2 (BIT_AND_EXPR, arg1_type,
-					 ffecom_expr (arg1),
-					 ffecom_2 (LSHIFT_EXPR, arg1_type,
-						   convert (arg1_type,
-							  integer_one_node),
-						   convert (integer_type_node,
-							    ffecom_expr (arg2)))),
-			       convert (arg1_type,
-					integer_zero_node))),
-		    false_tree,
-		    true_tree);
-      }
-
-    case FFEINTRIN_impIBCLR:
-      return
-	ffecom_2 (BIT_AND_EXPR, tree_type,
-		  ffecom_expr (arg1),
-		  ffecom_1 (BIT_NOT_EXPR, tree_type,
-			    ffecom_2 (LSHIFT_EXPR, tree_type,
-				      convert (tree_type,
-					       integer_one_node),
-				      convert (integer_type_node,
-					       ffecom_expr (arg2)))));
-
-    case FFEINTRIN_impIBITS:
-      {
-	tree arg3_tree = ffecom_save_tree (convert (integer_type_node,
-						    ffecom_expr (arg3)));
-	tree uns_type
-	= ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
-
-	expr_tree
-	  = ffecom_2 (BIT_AND_EXPR, tree_type,
-		      ffecom_2 (RSHIFT_EXPR, tree_type,
-				ffecom_expr (arg1),
-				convert (integer_type_node,
-					 ffecom_expr (arg2))),
-		      convert (tree_type,
-			       ffecom_2 (RSHIFT_EXPR, uns_type,
-					 ffecom_1 (BIT_NOT_EXPR,
-						   uns_type,
-						   convert (uns_type,
-							integer_zero_node)),
-					 ffecom_2 (MINUS_EXPR,
-						   integer_type_node,
-						   TYPE_SIZE (uns_type),
-						   arg3_tree))));
-	/* Fix up, because the RSHIFT_EXPR above can't shift over TYPE_SIZE.  */
-	expr_tree
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (NE_EXPR, integer_type_node,
-				 arg3_tree,
-				 integer_zero_node)),
-		      expr_tree,
-		      convert (tree_type, integer_zero_node));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impIBSET:
-      return
-	ffecom_2 (BIT_IOR_EXPR, tree_type,
-		  ffecom_expr (arg1),
-		  ffecom_2 (LSHIFT_EXPR, tree_type,
-			    convert (tree_type, integer_one_node),
-			    convert (integer_type_node,
-				     ffecom_expr (arg2))));
-
-    case FFEINTRIN_impISHFT:
-      {
-	tree arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
-	tree arg2_tree = ffecom_save_tree (convert (integer_type_node,
-						    ffecom_expr (arg2)));
-	tree uns_type
-	= ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
-
-	expr_tree
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (GE_EXPR, integer_type_node,
-				 arg2_tree,
-				 integer_zero_node)),
-		      ffecom_2 (LSHIFT_EXPR, tree_type,
-				arg1_tree,
-				arg2_tree),
-		      convert (tree_type,
-			       ffecom_2 (RSHIFT_EXPR, uns_type,
-					 convert (uns_type, arg1_tree),
-					 ffecom_1 (NEGATE_EXPR,
-						   integer_type_node,
-						   arg2_tree))));
-	/* Fix up, because {L|R}SHIFT_EXPR don't go over TYPE_SIZE bounds.  */
-	expr_tree
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (NE_EXPR, integer_type_node,
-				 ffecom_1 (ABS_EXPR,
-					   integer_type_node,
-					   arg2_tree),
-				 TYPE_SIZE (uns_type))),
-		      expr_tree,
-		      convert (tree_type, integer_zero_node));
-	/* Make sure SAVE_EXPRs get referenced early enough. */
-	expr_tree
-	  = ffecom_2 (COMPOUND_EXPR, tree_type,
-		      convert (void_type_node, arg1_tree),
-		      ffecom_2 (COMPOUND_EXPR, tree_type,
-				convert (void_type_node, arg2_tree),
-				expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impISHFTC:
-      {
-	tree arg1_tree = ffecom_save_tree (ffecom_expr (arg1));
-	tree arg2_tree = ffecom_save_tree (convert (integer_type_node,
-						    ffecom_expr (arg2)));
-	tree arg3_tree = (arg3 == NULL) ? TYPE_SIZE (tree_type)
-	: ffecom_save_tree (convert (integer_type_node, ffecom_expr (arg3)));
-	tree shift_neg;
-	tree shift_pos;
-	tree mask_arg1;
-	tree masked_arg1;
-	tree uns_type
-	= ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
-
-	mask_arg1
-	  = ffecom_2 (LSHIFT_EXPR, tree_type,
-		      ffecom_1 (BIT_NOT_EXPR, tree_type,
-				convert (tree_type, integer_zero_node)),
-		      arg3_tree);
-	/* Fix up, because LSHIFT_EXPR above can't shift over TYPE_SIZE.  */
-	mask_arg1
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (NE_EXPR, integer_type_node,
-				 arg3_tree,
-				 TYPE_SIZE (uns_type))),
-		      mask_arg1,
-		      convert (tree_type, integer_zero_node));
-	mask_arg1 = ffecom_save_tree (mask_arg1);
-	masked_arg1
-	  = ffecom_2 (BIT_AND_EXPR, tree_type,
-		      arg1_tree,
-		      ffecom_1 (BIT_NOT_EXPR, tree_type,
-				mask_arg1));
-	masked_arg1 = ffecom_save_tree (masked_arg1);
-	shift_neg
-	  = ffecom_2 (BIT_IOR_EXPR, tree_type,
-		      convert (tree_type,
-			       ffecom_2 (RSHIFT_EXPR, uns_type,
-					 convert (uns_type, masked_arg1),
-					 ffecom_1 (NEGATE_EXPR,
-						   integer_type_node,
-						   arg2_tree))),
-		      ffecom_2 (LSHIFT_EXPR, tree_type,
-				arg1_tree,
-				ffecom_2 (PLUS_EXPR, integer_type_node,
-					  arg2_tree,
-					  arg3_tree)));
-	shift_pos
-	  = ffecom_2 (BIT_IOR_EXPR, tree_type,
-		      ffecom_2 (LSHIFT_EXPR, tree_type,
-				arg1_tree,
-				arg2_tree),
-		      convert (tree_type,
-			       ffecom_2 (RSHIFT_EXPR, uns_type,
-					 convert (uns_type, masked_arg1),
-					 ffecom_2 (MINUS_EXPR,
-						   integer_type_node,
-						   arg3_tree,
-						   arg2_tree))));
-	expr_tree
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (LT_EXPR, integer_type_node,
-				 arg2_tree,
-				 integer_zero_node)),
-		      shift_neg,
-		      shift_pos);
-	expr_tree
-	  = ffecom_2 (BIT_IOR_EXPR, tree_type,
-		      ffecom_2 (BIT_AND_EXPR, tree_type,
-				mask_arg1,
-				arg1_tree),
-		      ffecom_2 (BIT_AND_EXPR, tree_type,
-				ffecom_1 (BIT_NOT_EXPR, tree_type,
-					  mask_arg1),
-				expr_tree));
-	expr_tree
-	  = ffecom_3 (COND_EXPR, tree_type,
-		      ffecom_truth_value
-		      (ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
-				 ffecom_2 (EQ_EXPR, integer_type_node,
-					   ffecom_1 (ABS_EXPR,
-						     integer_type_node,
-						     arg2_tree),
-					   arg3_tree),
-				 ffecom_2 (EQ_EXPR, integer_type_node,
-					   arg2_tree,
-					   integer_zero_node))),
-		      arg1_tree,
-		      expr_tree);
-	/* Make sure SAVE_EXPRs get referenced early enough. */
-	expr_tree
-	  = ffecom_2 (COMPOUND_EXPR, tree_type,
-		      convert (void_type_node, arg1_tree),
-		      ffecom_2 (COMPOUND_EXPR, tree_type,
-				convert (void_type_node, arg2_tree),
-				ffecom_2 (COMPOUND_EXPR, tree_type,
-					  convert (void_type_node,
-						   mask_arg1),
-					  ffecom_2 (COMPOUND_EXPR, tree_type,
-						    convert (void_type_node,
-							     masked_arg1),
-						    expr_tree))));
-	expr_tree
-	  = ffecom_2 (COMPOUND_EXPR, tree_type,
-		      convert (void_type_node,
-			       arg3_tree),
-		      expr_tree);
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impLOC:
-      {
-	tree arg1_tree = ffecom_expr (arg1);
-
-	expr_tree
-	  = convert (tree_type,
-		     ffecom_1 (ADDR_EXPR,
-			       build_pointer_type (TREE_TYPE (arg1_tree)),
-			       arg1_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impMVBITS:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg3_tree;
-	ffebld arg4 = ffebld_head (ffebld_trail (list));
-	tree arg4_tree;
-	tree arg4_type;
-	ffebld arg5 = ffebld_head (ffebld_trail (ffebld_trail (list)));
-	tree arg5_tree;
-	tree prep_arg1;
-	tree prep_arg4;
-	tree arg5_plus_arg3;
-
-	arg2_tree = convert (integer_type_node,
-			     ffecom_expr (arg2));
-	arg3_tree = ffecom_save_tree (convert (integer_type_node,
-					       ffecom_expr (arg3)));
-	arg4_tree = ffecom_expr_rw (NULL_TREE, arg4);
-	arg4_type = TREE_TYPE (arg4_tree);
-
-	arg1_tree = ffecom_save_tree (convert (arg4_type,
-					       ffecom_expr (arg1)));
-
-	arg5_tree = ffecom_save_tree (convert (integer_type_node,
-					       ffecom_expr (arg5)));
-
-	prep_arg1
-	  = ffecom_2 (LSHIFT_EXPR, arg4_type,
-		      ffecom_2 (BIT_AND_EXPR, arg4_type,
-				ffecom_2 (RSHIFT_EXPR, arg4_type,
-					  arg1_tree,
-					  arg2_tree),
-				ffecom_1 (BIT_NOT_EXPR, arg4_type,
-					  ffecom_2 (LSHIFT_EXPR, arg4_type,
-						    ffecom_1 (BIT_NOT_EXPR,
-							      arg4_type,
-							      convert
-							      (arg4_type,
-							integer_zero_node)),
-						    arg3_tree))),
-		      arg5_tree);
-	arg5_plus_arg3
-	  = ffecom_save_tree (ffecom_2 (PLUS_EXPR, arg4_type,
-					arg5_tree,
-					arg3_tree));
-	prep_arg4
-	  = ffecom_2 (LSHIFT_EXPR, arg4_type,
-		      ffecom_1 (BIT_NOT_EXPR, arg4_type,
-				convert (arg4_type,
-					 integer_zero_node)),
-		      arg5_plus_arg3);
-	/* Fix up, because LSHIFT_EXPR above can't shift over TYPE_SIZE.  */
-	prep_arg4
-	  = ffecom_3 (COND_EXPR, arg4_type,
-		      ffecom_truth_value
-		      (ffecom_2 (NE_EXPR, integer_type_node,
-				 arg5_plus_arg3,
-				 convert (TREE_TYPE (arg5_plus_arg3),
-					  TYPE_SIZE (arg4_type)))),
-		      prep_arg4,
-		      convert (arg4_type, integer_zero_node));
-	prep_arg4
-	  = ffecom_2 (BIT_AND_EXPR, arg4_type,
-		      arg4_tree,
-		      ffecom_2 (BIT_IOR_EXPR, arg4_type,
-				prep_arg4,
-				ffecom_1 (BIT_NOT_EXPR, arg4_type,
-					  ffecom_2 (LSHIFT_EXPR, arg4_type,
-						    ffecom_1 (BIT_NOT_EXPR,
-							      arg4_type,
-							      convert
-							      (arg4_type,
-							integer_zero_node)),
-						    arg5_tree))));
-	prep_arg1
-	  = ffecom_2 (BIT_IOR_EXPR, arg4_type,
-		      prep_arg1,
-		      prep_arg4);
-	/* Fix up (twice), because LSHIFT_EXPR above
-	   can't shift over TYPE_SIZE.  */
-	prep_arg1
-	  = ffecom_3 (COND_EXPR, arg4_type,
-		      ffecom_truth_value
-		      (ffecom_2 (NE_EXPR, integer_type_node,
-				 arg3_tree,
-				 convert (TREE_TYPE (arg3_tree),
-					  integer_zero_node))),
-		      prep_arg1,
-		      arg4_tree);
-	prep_arg1
-	  = ffecom_3 (COND_EXPR, arg4_type,
-		      ffecom_truth_value
-		      (ffecom_2 (NE_EXPR, integer_type_node,
-				 arg3_tree,
-				 convert (TREE_TYPE (arg3_tree),
-					  TYPE_SIZE (arg4_type)))),
-		      prep_arg1,
-		      arg1_tree);
-	expr_tree
-	  = ffecom_2s (MODIFY_EXPR, void_type_node,
-		       arg4_tree,
-		       prep_arg1);
-	/* Make sure SAVE_EXPRs get referenced early enough. */
-	expr_tree
-	  = ffecom_2 (COMPOUND_EXPR, void_type_node,
-		      arg1_tree,
-		      ffecom_2 (COMPOUND_EXPR, void_type_node,
-				arg3_tree,
-				ffecom_2 (COMPOUND_EXPR, void_type_node,
-					  arg5_tree,
-					  ffecom_2 (COMPOUND_EXPR, void_type_node,
-						    arg5_plus_arg3,
-						    expr_tree))));
-	expr_tree
-	  = ffecom_2 (COMPOUND_EXPR, void_type_node,
-		      arg4_tree,
-		      expr_tree);
-
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impDERF:
-    case FFEINTRIN_impERF:
-    case FFEINTRIN_impDERFC:
-    case FFEINTRIN_impERFC:
-      break;
-
-    case FFEINTRIN_impIARGC:
-      /* extern int xargc; i__1 = xargc - 1; */
-      expr_tree = ffecom_2 (MINUS_EXPR, TREE_TYPE (ffecom_tree_xargc_),
-			    ffecom_tree_xargc_,
-			    convert (TREE_TYPE (ffecom_tree_xargc_),
-				     integer_one_node));
-      return expr_tree;
-
-    case FFEINTRIN_impSIGNAL_func:
-    case FFEINTRIN_impSIGNAL_subr:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg3_tree;
-
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg1));
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-
-	/* Pass procedure as a pointer to it, anything else by value.  */
-	if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY)
-	  arg2_tree = convert (integer_type_node, ffecom_expr (arg2));
-	else
-	  arg2_tree = ffecom_ptr_to_expr (arg2);
-	arg2_tree = convert (TREE_TYPE (null_pointer_node),
-			     arg2_tree);
-
-	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-	else
-	  arg3_tree = NULL_TREE;
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-
-	expr_tree
-	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-			  ffecom_gfrt_kindtype (gfrt),
-			  FALSE,
-			  ((codegen_imp == FFEINTRIN_impSIGNAL_subr) ?
-			   NULL_TREE :
-			   tree_type),
-			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-			  ffebld_nonter_hook (expr));
-
-	if (arg3_tree != NULL_TREE)
-	  expr_tree
-	    = ffecom_modify (NULL_TREE, arg3_tree,
-			     convert (TREE_TYPE (arg3_tree),
-				      expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impALARM:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg3_tree;
-
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg1));
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-
-	/* Pass procedure as a pointer to it, anything else by value.  */
-	if (ffeinfo_kind (ffebld_info (arg2)) == FFEINFO_kindENTITY)
-	  arg2_tree = convert (integer_type_node, ffecom_expr (arg2));
-	else
-	  arg2_tree = ffecom_ptr_to_expr (arg2);
-	arg2_tree = convert (TREE_TYPE (null_pointer_node),
-			     arg2_tree);
-
-	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-	else
-	  arg3_tree = NULL_TREE;
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-
-	expr_tree
-	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-			  ffecom_gfrt_kindtype (gfrt),
-			  FALSE,
-			  NULL_TREE,
-			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-			  ffebld_nonter_hook (expr));
-
-	if (arg3_tree != NULL_TREE)
-	  expr_tree
-	    = ffecom_modify (NULL_TREE, arg3_tree,
-			     convert (TREE_TYPE (arg3_tree),
-				      expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impCHDIR_subr:
-    case FFEINTRIN_impFDATE_subr:
-    case FFEINTRIN_impFGET_subr:
-    case FFEINTRIN_impFPUT_subr:
-    case FFEINTRIN_impGETCWD_subr:
-    case FFEINTRIN_impHOSTNM_subr:
-    case FFEINTRIN_impSYSTEM_subr:
-    case FFEINTRIN_impUNLINK_subr:
-      {
-	tree arg1_len = integer_zero_node;
-	tree arg1_tree;
-	tree arg2_tree;
-
-	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
-
-	if (arg2 != NULL)
-	  arg2_tree = ffecom_expr_w (NULL_TREE, arg2);
-	else
-	  arg2_tree = NULL_TREE;
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg1_len = build_tree_list (NULL_TREE, arg1_len);
-	TREE_CHAIN (arg1_tree) = arg1_len;
-
-	expr_tree
-	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-			  ffecom_gfrt_kindtype (gfrt),
-			  FALSE,
-			  NULL_TREE,
-			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-			  ffebld_nonter_hook (expr));
-
-	if (arg2_tree != NULL_TREE)
-	  expr_tree
-	    = ffecom_modify (NULL_TREE, arg2_tree,
-			     convert (TREE_TYPE (arg2_tree),
-				      expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impEXIT:
-      if (arg1 != NULL)
-	break;
-
-      expr_tree = build_tree_list (NULL_TREE,
-				   ffecom_1 (ADDR_EXPR,
-					     build_pointer_type
-					     (ffecom_integer_type_node),
-					     integer_zero_node));
-
-      return
-	ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-		      ffecom_gfrt_kindtype (gfrt),
-		      FALSE,
-		      void_type_node,
-		      expr_tree,
-		      NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-		      ffebld_nonter_hook (expr));
-
-    case FFEINTRIN_impFLUSH:
-      if (arg1 == NULL)
-	gfrt = FFECOM_gfrtFLUSH;
-      else
-	gfrt = FFECOM_gfrtFLUSH1;
-      break;
-
-    case FFEINTRIN_impCHMOD_subr:
-    case FFEINTRIN_impLINK_subr:
-    case FFEINTRIN_impRENAME_subr:
-    case FFEINTRIN_impSYMLNK_subr:
-      {
-	tree arg1_len = integer_zero_node;
-	tree arg1_tree;
-	tree arg2_len = integer_zero_node;
-	tree arg2_tree;
-	tree arg3_tree;
-
-	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
-	arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
-	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-	else
-	  arg3_tree = NULL_TREE;
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg1_len = build_tree_list (NULL_TREE, arg1_len);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	arg2_len = build_tree_list (NULL_TREE, arg2_len);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-	TREE_CHAIN (arg2_tree) = arg1_len;
-	TREE_CHAIN (arg1_len) = arg2_len;
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-				  ffebld_nonter_hook (expr));
-	if (arg3_tree != NULL_TREE)
-	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
-				     convert (TREE_TYPE (arg3_tree),
-					      expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impLSTAT_subr:
-    case FFEINTRIN_impSTAT_subr:
-      {
-	tree arg1_len = integer_zero_node;
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg3_tree;
-
-	arg1_tree = ffecom_arg_ptr_to_expr (arg1, &arg1_len);
-
-	arg2_tree = ffecom_ptr_to_expr (arg2);
-
-	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-	else
-	  arg3_tree = NULL_TREE;
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg1_len = build_tree_list (NULL_TREE, arg1_len);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-	TREE_CHAIN (arg2_tree) = arg1_len;
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-				  ffebld_nonter_hook (expr));
-	if (arg3_tree != NULL_TREE)
-	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
-				     convert (TREE_TYPE (arg3_tree),
-					      expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impFGETC_subr:
-    case FFEINTRIN_impFPUTC_subr:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg2_len = integer_zero_node;
-	tree arg3_tree;
-
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg1));
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-
-	arg2_tree = ffecom_arg_ptr_to_expr (arg2, &arg2_len);
-	if (arg3 != NULL)
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-	else
-	  arg3_tree = NULL_TREE;
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	arg2_len = build_tree_list (NULL_TREE, arg2_len);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-	TREE_CHAIN (arg2_tree) = arg2_len;
-
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-				  ffebld_nonter_hook (expr));
-	if (arg3_tree != NULL_TREE)
-	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
-				     convert (TREE_TYPE (arg3_tree),
-					      expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impFSTAT_subr:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg3_tree;
-
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg1));
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-
-	arg2_tree = convert (ffecom_f2c_ptr_to_integer_type_node,
-			     ffecom_ptr_to_expr (arg2));
-
-	if (arg3 == NULL)
-	  arg3_tree = NULL_TREE;
-	else
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-				  ffebld_nonter_hook (expr));
-	if (arg3_tree != NULL_TREE) {
-	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
-				     convert (TREE_TYPE (arg3_tree),
-					      expr_tree));
-	}
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impKILL_subr:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-	tree arg3_tree;
-
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg1));
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-
-	arg2_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg2));
-	arg2_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg2_tree)),
-			      arg2_tree);
-
-	if (arg3 == NULL)
-	  arg3_tree = NULL_TREE;
-	else
-	  arg3_tree = ffecom_expr_w (NULL_TREE, arg3);
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	TREE_CHAIN (arg1_tree) = arg2_tree;
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  arg1_tree,
-				  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-				  ffebld_nonter_hook (expr));
-	if (arg3_tree != NULL_TREE) {
-	  expr_tree = ffecom_modify (NULL_TREE, arg3_tree,
-				     convert (TREE_TYPE (arg3_tree),
-					      expr_tree));
-	}
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impCTIME_subr:
-    case FFEINTRIN_impTTYNAM_subr:
-      {
-	tree arg1_len = integer_zero_node;
-	tree arg1_tree;
-	tree arg2_tree;
-
-	arg1_tree = ffecom_arg_ptr_to_expr (arg2, &arg1_len);
-
-	arg2_tree = convert (((codegen_imp == FFEINTRIN_impCTIME_subr) ?
-			      ffecom_f2c_longint_type_node :
-			      ffecom_f2c_integer_type_node),
-			     ffecom_expr (arg1));
-	arg2_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg2_tree)),
-			      arg2_tree);
-
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-	arg1_len = build_tree_list (NULL_TREE, arg1_len);
-	arg2_tree = build_tree_list (NULL_TREE, arg2_tree);
-	TREE_CHAIN (arg1_len) = arg2_tree;
-	TREE_CHAIN (arg1_tree) = arg1_len;
-
-	expr_tree
-	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-			  ffecom_gfrt_kindtype (gfrt),
-			  FALSE,
-			  NULL_TREE,
-			  arg1_tree,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-			  ffebld_nonter_hook (expr));
-	TREE_SIDE_EFFECTS (expr_tree) = 1;
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impIRAND:
-    case FFEINTRIN_impRAND:
-      /* Arg defaults to 0 (normal random case) */
-      {
-	tree arg1_tree;
-
-	if (arg1 == NULL)
-	  arg1_tree = ffecom_integer_zero_node;
-	else
-	  arg1_tree = ffecom_expr (arg1);
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     arg1_tree);
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-	arg1_tree = build_tree_list (NULL_TREE, arg1_tree);
-
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  ((codegen_imp == FFEINTRIN_impIRAND) ?
-				   ffecom_f2c_integer_type_node :
-				   ffecom_f2c_real_type_node),
-				  arg1_tree,
-				  dest_tree, dest, dest_used,
-				  NULL_TREE, TRUE,
-				  ffebld_nonter_hook (expr));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impFTELL_subr:
-    case FFEINTRIN_impUMASK_subr:
-      {
-	tree arg1_tree;
-	tree arg2_tree;
-
-	arg1_tree = convert (ffecom_f2c_integer_type_node,
-			     ffecom_expr (arg1));
-	arg1_tree = ffecom_1 (ADDR_EXPR,
-			      build_pointer_type (TREE_TYPE (arg1_tree)),
-			      arg1_tree);
-
-	if (arg2 == NULL)
-	  arg2_tree = NULL_TREE;
-	else
-	  arg2_tree = ffecom_expr_w (NULL_TREE, arg2);
-
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  build_tree_list (NULL_TREE, arg1_tree),
-				  NULL_TREE, NULL, NULL, NULL_TREE,
-				  TRUE,
-				  ffebld_nonter_hook (expr));
-	if (arg2_tree != NULL_TREE) {
-	  expr_tree = ffecom_modify (NULL_TREE, arg2_tree,
-				     convert (TREE_TYPE (arg2_tree),
-					      expr_tree));
-	}
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impCPU_TIME:
-    case FFEINTRIN_impSECOND_subr:
-      {
-	tree arg1_tree;
-
-	arg1_tree = ffecom_expr_w (NULL_TREE, arg1);
-
-	expr_tree
-	  = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-			  ffecom_gfrt_kindtype (gfrt),
-			  FALSE,
-			  NULL_TREE,
-			  NULL_TREE,
-			  NULL_TREE, NULL, NULL, NULL_TREE, TRUE,
-			  ffebld_nonter_hook (expr));
-
-	expr_tree
-	  = ffecom_modify (NULL_TREE, arg1_tree,
-			   convert (TREE_TYPE (arg1_tree),
-				    expr_tree));
-      }
-      return expr_tree;
-
-    case FFEINTRIN_impDTIME_subr:
-    case FFEINTRIN_impETIME_subr:
-      {
-	tree arg1_tree;
-	tree result_tree;
-
-	result_tree = ffecom_expr_w (NULL_TREE, arg2);
-
-	arg1_tree = ffecom_ptr_to_expr (arg1);
-
-	expr_tree = ffecom_call_ (ffecom_gfrt_tree_ (gfrt),
-				  ffecom_gfrt_kindtype (gfrt),
-				  FALSE,
-				  NULL_TREE,
-				  build_tree_list (NULL_TREE, arg1_tree),
-				  NULL_TREE, NULL, NULL, NULL_TREE,
-				  TRUE,
-				  ffebld_nonter_hook (expr));
-	expr_tree = ffecom_modify (NULL_TREE, result_tree,
-				   convert (TREE_TYPE (result_tree),
-					    expr_tree));
-      }
-      return expr_tree;
-
-      /* Straightforward calls of libf2c routines: */
-    case FFEINTRIN_impABORT:
-    case FFEINTRIN_impACCESS:
-    case FFEINTRIN_impBESJ0:
-    case FFEINTRIN_impBESJ1:
-    case FFEINTRIN_impBESJN:
-    case FFEINTRIN_impBESY0:
-    case FFEINTRIN_impBESY1:
-    case FFEINTRIN_impBESYN:
-    case FFEINTRIN_impCHDIR_func:
-    case FFEINTRIN_impCHMOD_func:
-    case FFEINTRIN_impDATE:
-    case FFEINTRIN_impDATE_AND_TIME:
-    case FFEINTRIN_impDBESJ0:
-    case FFEINTRIN_impDBESJ1:
-    case FFEINTRIN_impDBESJN:
-    case FFEINTRIN_impDBESY0:
-    case FFEINTRIN_impDBESY1:
-    case FFEINTRIN_impDBESYN:
-    case FFEINTRIN_impDTIME_func:
-    case FFEINTRIN_impETIME_func:
-    case FFEINTRIN_impFGETC_func:
-    case FFEINTRIN_impFGET_func:
-    case FFEINTRIN_impFNUM:
-    case FFEINTRIN_impFPUTC_func:
-    case FFEINTRIN_impFPUT_func:
-    case FFEINTRIN_impFSEEK:
-    case FFEINTRIN_impFSTAT_func:
-    case FFEINTRIN_impFTELL_func:
-    case FFEINTRIN_impGERROR:
-    case FFEINTRIN_impGETARG:
-    case FFEINTRIN_impGETCWD_func:
-    case FFEINTRIN_impGETENV:
-    case FFEINTRIN_impGETGID:
-    case FFEINTRIN_impGETLOG:
-    case FFEINTRIN_impGETPID:
-    case FFEINTRIN_impGETUID:
-    case FFEINTRIN_impGMTIME:
-    case FFEINTRIN_impHOSTNM_func:
-    case FFEINTRIN_impIDATE_unix:
-    case FFEINTRIN_impIDATE_vxt:
-    case FFEINTRIN_impIERRNO:
-    case FFEINTRIN_impISATTY:
-    case FFEINTRIN_impITIME:
-    case FFEINTRIN_impKILL_func:
-    case FFEINTRIN_impLINK_func:
-    case FFEINTRIN_impLNBLNK:
-    case FFEINTRIN_impLSTAT_func:
-    case FFEINTRIN_impLTIME:
-    case FFEINTRIN_impMCLOCK8:
-    case FFEINTRIN_impMCLOCK:
-    case FFEINTRIN_impPERROR:
-    case FFEINTRIN_impRENAME_func:
-    case FFEINTRIN_impSECNDS:
-    case FFEINTRIN_impSECOND_func:
-    case FFEINTRIN_impSLEEP:
-    case FFEINTRIN_impSRAND:
-    case FFEINTRIN_impSTAT_func:
-    case FFEINTRIN_impSYMLNK_func:
-    case FFEINTRIN_impSYSTEM_CLOCK:
-    case FFEINTRIN_impSYSTEM_func:
-    case FFEINTRIN_impTIME8:
-    case FFEINTRIN_impTIME_unix:
-    case FFEINTRIN_impTIME_vxt:
-    case FFEINTRIN_impUMASK_func:
-    case FFEINTRIN_impUNLINK_func:
-      break;
-
-    case FFEINTRIN_impCTIME_func:	/* CHARACTER functions not handled here. */
-    case FFEINTRIN_impFDATE_func:	/* CHARACTER functions not handled here. */
-    case FFEINTRIN_impTTYNAM_func:	/* CHARACTER functions not handled here. */
-    case FFEINTRIN_impNONE:
-    case FFEINTRIN_imp:		/* Hush up gcc warning. */
-      fprintf (stderr, "No %s implementation.\n",
-	       ffeintrin_name_implementation (ffebld_symter_implementation (ffebld_left (expr))));
-      assert ("unimplemented intrinsic" == NULL);
-      return error_mark_node;
-    }
-
-  assert (gfrt != FFECOM_gfrt);	/* Must have an implementation! */
-
-  expr_tree = ffecom_arglist_expr_ (ffecom_gfrt_args_ (gfrt),
-				    ffebld_right (expr));
-
-  return ffecom_call_ (ffecom_gfrt_tree_ (gfrt), ffecom_gfrt_kindtype (gfrt),
-		       (ffe_is_f2c_library () && ffecom_gfrt_complex_[gfrt]),
-		       tree_type,
-		       expr_tree, dest_tree, dest, dest_used,
-		       NULL_TREE, TRUE,
-		       ffebld_nonter_hook (expr));
-
-  /* See bottom of this file for f2c transforms used to determine
-     many of the above implementations.  The info seems to confuse
-     Emacs's C mode indentation, which is why it's been moved to
-     the bottom of this source file.  */
-}
-
-/* For power (exponentiation) where right-hand operand is type INTEGER,
-   generate in-line code to do it the fast way (which, if the operand
-   is a constant, might just mean a series of multiplies).  */
-
-static tree
-ffecom_expr_power_integer_ (ffebld expr)
-{
-  tree l = ffecom_expr (ffebld_left (expr));
-  tree r = ffecom_expr (ffebld_right (expr));
-  tree ltype = TREE_TYPE (l);
-  tree rtype = TREE_TYPE (r);
-  tree result = NULL_TREE;
-
-  if (l == error_mark_node
-      || r == error_mark_node)
-    return error_mark_node;
-
-  if (TREE_CODE (r) == INTEGER_CST)
-    {
-      int sgn = tree_int_cst_sgn (r);
-
-      if (sgn == 0)
-	return convert (ltype, integer_one_node);
-
-      if ((TREE_CODE (ltype) == INTEGER_TYPE)
-	  && (sgn < 0))
-	{
-	  /* Reciprocal of integer is either 0, -1, or 1, so after
-	     calculating that (which we leave to the back end to do
-	     or not do optimally), don't bother with any multiplying.  */
-
-	  result = ffecom_tree_divide_ (ltype,
-					convert (ltype, integer_one_node),
-					l,
-					NULL_TREE, NULL, NULL, NULL_TREE);
-	  r = ffecom_1 (NEGATE_EXPR,
-			rtype,
-			r);
-	  if ((TREE_INT_CST_LOW (r) & 1) == 0)
-	    result = ffecom_1 (ABS_EXPR, rtype,
-			       result);
-	}
-
-      /* Generate appropriate series of multiplies, preceded
-	 by divide if the exponent is negative.  */
-
-      l = save_expr (l);
-
-      if (sgn < 0)
-	{
-	  l = ffecom_tree_divide_ (ltype,
-				   convert (ltype, integer_one_node),
-				   l,
-				   NULL_TREE, NULL, NULL,
-				   ffebld_nonter_hook (expr));
-	  r = ffecom_1 (NEGATE_EXPR, rtype, r);
-	  assert (TREE_CODE (r) == INTEGER_CST);
-
-	  if (tree_int_cst_sgn (r) < 0)
-	    {			/* The "most negative" number.  */
-	      r = ffecom_1 (NEGATE_EXPR, rtype,
-			    ffecom_2 (RSHIFT_EXPR, rtype,
-				      r,
-				      integer_one_node));
-	      l = save_expr (l);
-	      l = ffecom_2 (MULT_EXPR, ltype,
-			    l,
-			    l);
-	    }
-	}
-
-      for (;;)
-	{
-	  if (TREE_INT_CST_LOW (r) & 1)
-	    {
-	      if (result == NULL_TREE)
-		result = l;
-	      else
-		result = ffecom_2 (MULT_EXPR, ltype,
-				   result,
-				   l);
-	    }
-
-	  r = ffecom_2 (RSHIFT_EXPR, rtype,
-			r,
-			integer_one_node);
-	  if (integer_zerop (r))
-	    break;
-	  assert (TREE_CODE (r) == INTEGER_CST);
-
-	  l = save_expr (l);
-	  l = ffecom_2 (MULT_EXPR, ltype,
-			l,
-			l);
-	}
-      return result;
-    }
-
-  /* Though rhs isn't a constant, in-line code cannot be expanded
-     while transforming dummies
-     because the back end cannot be easily convinced to generate
-     stores (MODIFY_EXPR), handle temporaries, and so on before
-     all the appropriate rtx's have been generated for things like
-     dummy args referenced in rhs -- which doesn't happen until
-     store_parm_decls() is called (expand_function_start, I believe,
-     does the actual rtx-stuffing of PARM_DECLs).
-
-     So, in this case, let the caller generate the call to the
-     run-time-library function to evaluate the power for us.  */
-
-  if (ffecom_transform_only_dummies_)
-    return NULL_TREE;
-
-  /* Right-hand operand not a constant, expand in-line code to figure
-     out how to do the multiplies, &c.
-
-     The returned expression is expressed this way in GNU C, where l and
-     r are the "inputs":
-
-     ({ typeof (r) rtmp = r;
-	typeof (l) ltmp = l;
-	typeof (l) result;
-
-	if (rtmp == 0)
-	  result = 1;
-	else
-	  {
-	    if ((basetypeof (l) == basetypeof (int))
-		&& (rtmp < 0))
-	      {
-	        result = ((typeof (l)) 1) / ltmp;
-	        if ((ltmp < 0) && (((-rtmp) & 1) == 0))
-		  result = -result;
-	      }
-	    else
-	      {
-		result = 1;
-		if ((basetypeof (l) != basetypeof (int))
-		    && (rtmp < 0))
-		  {
-		    ltmp = ((typeof (l)) 1) / ltmp;
-		    rtmp = -rtmp;
-		    if (rtmp < 0)
-		      {
-		        rtmp = -(rtmp >> 1);
-		        ltmp *= ltmp;
-		      }
-		  }
-		for (;;)
-		  {
-		    if (rtmp & 1)
-		      result *= ltmp;
-		    if ((rtmp >>= 1) == 0)
-		      break;
-		    ltmp *= ltmp;
-		  }
-	      }
-	  }
-	result;
-     })
-
-     Note that some of the above is compile-time collapsable, such as
-     the first part of the if statements that checks the base type of
-     l against int.  The if statements are phrased that way to suggest
-     an easy way to generate the if/else constructs here, knowing that
-     the back end should (and probably does) eliminate the resulting
-     dead code (either the int case or the non-int case), something
-     it couldn't do without the redundant phrasing, requiring explicit
-     dead-code elimination here, which would be kind of difficult to
-     read.  */
-
-  {
-    tree rtmp;
-    tree ltmp;
-    tree divide;
-    tree basetypeof_l_is_int;
-    tree se;
-    tree t;
-
-    basetypeof_l_is_int
-      = build_int_2 ((TREE_CODE (ltype) == INTEGER_TYPE), 0);
-
-    se = expand_start_stmt_expr (/*has_scope=*/1);
-
-    ffecom_start_compstmt ();
-
-    rtmp = ffecom_make_tempvar ("power_r", rtype,
-				FFETARGET_charactersizeNONE, -1);
-    ltmp = ffecom_make_tempvar ("power_l", ltype,
-				FFETARGET_charactersizeNONE, -1);
-    result = ffecom_make_tempvar ("power_res", ltype,
-				  FFETARGET_charactersizeNONE, -1);
-    if (TREE_CODE (ltype) == COMPLEX_TYPE
-	|| TREE_CODE (ltype) == RECORD_TYPE)
-      divide = ffecom_make_tempvar ("power_div", ltype,
-				    FFETARGET_charactersizeNONE, -1);
-    else
-      divide = NULL_TREE;
-
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     rtmp,
-				     r));
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     ltmp,
-				     l));
-    expand_start_cond (ffecom_truth_value
-		       (ffecom_2 (EQ_EXPR, integer_type_node,
-				  rtmp,
-				  convert (rtype, integer_zero_node))),
-		       0);
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     result,
-				     convert (ltype, integer_one_node)));
-    expand_start_else ();
-    if (! integer_zerop (basetypeof_l_is_int))
-      {
-	expand_start_cond (ffecom_2 (LT_EXPR, integer_type_node,
-				     rtmp,
-				     convert (rtype,
-					      integer_zero_node)),
-			   0);
-	expand_expr_stmt (ffecom_modify (void_type_node,
-					 result,
-					 ffecom_tree_divide_
-					 (ltype,
-					  convert (ltype, integer_one_node),
-					  ltmp,
-					  NULL_TREE, NULL, NULL,
-					  divide)));
-	expand_start_cond (ffecom_truth_value
-			   (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
-				      ffecom_2 (LT_EXPR, integer_type_node,
-						ltmp,
-						convert (ltype,
-							 integer_zero_node)),
-				      ffecom_2 (EQ_EXPR, integer_type_node,
-						ffecom_2 (BIT_AND_EXPR,
-							  rtype,
-							  ffecom_1 (NEGATE_EXPR,
-								    rtype,
-								    rtmp),
-							  convert (rtype,
-								   integer_one_node)),
-						convert (rtype,
-							 integer_zero_node)))),
-			   0);
-	expand_expr_stmt (ffecom_modify (void_type_node,
-					 result,
-					 ffecom_1 (NEGATE_EXPR,
-						   ltype,
-						   result)));
-	expand_end_cond ();
-	expand_start_else ();
-      }
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     result,
-				     convert (ltype, integer_one_node)));
-    expand_start_cond (ffecom_truth_value
-		       (ffecom_2 (TRUTH_ANDIF_EXPR, integer_type_node,
-				  ffecom_truth_value_invert
-				  (basetypeof_l_is_int),
-				  ffecom_2 (LT_EXPR, integer_type_node,
-					    rtmp,
-					    convert (rtype,
-						     integer_zero_node)))),
-		       0);
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     ltmp,
-				     ffecom_tree_divide_
-				     (ltype,
-				      convert (ltype, integer_one_node),
-				      ltmp,
-				      NULL_TREE, NULL, NULL,
-				      divide)));
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     rtmp,
-				     ffecom_1 (NEGATE_EXPR, rtype,
-					       rtmp)));
-    expand_start_cond (ffecom_truth_value
-		       (ffecom_2 (LT_EXPR, integer_type_node,
-				  rtmp,
-				  convert (rtype, integer_zero_node))),
-		       0);
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     rtmp,
-				     ffecom_1 (NEGATE_EXPR, rtype,
-					       ffecom_2 (RSHIFT_EXPR,
-							 rtype,
-							 rtmp,
-							 integer_one_node))));
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     ltmp,
-				     ffecom_2 (MULT_EXPR, ltype,
-					       ltmp,
-					       ltmp)));
-    expand_end_cond ();
-    expand_end_cond ();
-    expand_start_loop (1);
-    expand_start_cond (ffecom_truth_value
-		       (ffecom_2 (BIT_AND_EXPR, rtype,
-				  rtmp,
-				  convert (rtype, integer_one_node))),
-		       0);
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     result,
-				     ffecom_2 (MULT_EXPR, ltype,
-					       result,
-					       ltmp)));
-    expand_end_cond ();
-    expand_exit_loop_if_false (NULL,
-			       ffecom_truth_value
-			       (ffecom_modify (rtype,
-					       rtmp,
-					       ffecom_2 (RSHIFT_EXPR,
-							 rtype,
-							 rtmp,
-							 integer_one_node))));
-    expand_expr_stmt (ffecom_modify (void_type_node,
-				     ltmp,
-				     ffecom_2 (MULT_EXPR, ltype,
-					       ltmp,
-					       ltmp)));
-    expand_end_loop ();
-    expand_end_cond ();
-    if (!integer_zerop (basetypeof_l_is_int))
-      expand_end_cond ();
-    expand_expr_stmt (result);
-
-    t = ffecom_end_compstmt ();
-
-    result = expand_end_stmt_expr (se);
-
-    /* This code comes from c-parse.in, after its expand_end_stmt_expr.  */
-
-    if (TREE_CODE (t) == BLOCK)
-      {
-	/* Make a BIND_EXPR for the BLOCK already made.  */
-	result = build (BIND_EXPR, TREE_TYPE (result),
-			NULL_TREE, result, t);
-	/* Remove the block from the tree at this point.
-	   It gets put back at the proper place
-	   when the BIND_EXPR is expanded.  */
-	delete_block (t);
-      }
-    else
-      result = t;
-  }
-
-  return result;
-}
-
-/* ffecom_expr_transform_ -- Transform symbols in expr
-
-   ffebld expr;	 // FFE expression.
-   ffecom_expr_transform_ (expr);
-
-   Recursive descent on expr while transforming any untransformed SYMTERs.  */
-
-static void
-ffecom_expr_transform_ (ffebld expr)
-{
-  tree t;
-  ffesymbol s;
-
- tail_recurse:
-
-  if (expr == NULL)
-    return;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opSYMTER:
-      s = ffebld_symter (expr);
-      t = ffesymbol_hook (s).decl_tree;
-      if ((t == NULL_TREE)
-	  && ((ffesymbol_kind (s) != FFEINFO_kindNONE)
-	      || ((ffesymbol_where (s) != FFEINFO_whereNONE)
-		  && (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))))
-	{
-	  s = ffecom_sym_transform_ (s);
-	  t = ffesymbol_hook (s).decl_tree;	/* Sfunc expr non-dummy,
-						   DIMENSION expr? */
-	}
-      break;			/* Ok if (t == NULL) here. */
-
-    case FFEBLD_opITEM:
-      ffecom_expr_transform_ (ffebld_head (expr));
-      expr = ffebld_trail (expr);
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    default:
-      break;
-    }
-
-  switch (ffebld_arity (expr))
-    {
-    case 2:
-      ffecom_expr_transform_ (ffebld_left (expr));
-      expr = ffebld_right (expr);
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    case 1:
-      expr = ffebld_left (expr);
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    default:
-      break;
-    }
-
-  return;
-}
-
-/* Make a type based on info in live f2c.h file.  */
-
-static void
-ffecom_f2c_make_type_ (tree *type, int tcode, const char *name)
-{
-  switch (tcode)
-    {
-    case FFECOM_f2ccodeCHAR:
-      *type = make_signed_type (CHAR_TYPE_SIZE);
-      break;
-
-    case FFECOM_f2ccodeSHORT:
-      *type = make_signed_type (SHORT_TYPE_SIZE);
-      break;
-
-    case FFECOM_f2ccodeINT:
-      *type = make_signed_type (INT_TYPE_SIZE);
-      break;
-
-    case FFECOM_f2ccodeLONG:
-      *type = make_signed_type (LONG_TYPE_SIZE);
-      break;
-
-    case FFECOM_f2ccodeLONGLONG:
-      *type = make_signed_type (LONG_LONG_TYPE_SIZE);
-      break;
-
-    case FFECOM_f2ccodeCHARPTR:
-      *type = build_pointer_type (DEFAULT_SIGNED_CHAR
-				  ? signed_char_type_node
-				  : unsigned_char_type_node);
-      break;
-
-    case FFECOM_f2ccodeFLOAT:
-      *type = make_node (REAL_TYPE);
-      TYPE_PRECISION (*type) = FLOAT_TYPE_SIZE;
-      layout_type (*type);
-      break;
-
-    case FFECOM_f2ccodeDOUBLE:
-      *type = make_node (REAL_TYPE);
-      TYPE_PRECISION (*type) = DOUBLE_TYPE_SIZE;
-      layout_type (*type);
-      break;
-
-    case FFECOM_f2ccodeLONGDOUBLE:
-      *type = make_node (REAL_TYPE);
-      TYPE_PRECISION (*type) = LONG_DOUBLE_TYPE_SIZE;
-      layout_type (*type);
-      break;
-
-    case FFECOM_f2ccodeTWOREALS:
-      *type = ffecom_make_complex_type_ (ffecom_f2c_real_type_node);
-      break;
-
-    case FFECOM_f2ccodeTWODOUBLEREALS:
-      *type = ffecom_make_complex_type_ (ffecom_f2c_doublereal_type_node);
-      break;
-
-    default:
-      assert ("unexpected FFECOM_f2ccodeXYZZY!" == NULL);
-      *type = error_mark_node;
-      return;
-    }
-
-  pushdecl (build_decl (TYPE_DECL,
-			ffecom_get_invented_identifier ("__g77_f2c_%s", name),
-			*type));
-}
-
-/* Set the f2c list-directed-I/O code for whatever (integral) type has the
-   given size.  */
-
-static void
-ffecom_f2c_set_lio_code_ (ffeinfoBasictype bt, int size, int code)
-{
-  int j;
-  tree t;
-
-  for (j = 0; ((size_t) j) < ARRAY_SIZE (ffecom_tree_type[0]); ++j)
-    if ((t = ffecom_tree_type[bt][j]) != NULL_TREE
-	&& compare_tree_int (TYPE_SIZE (t), size) == 0)
-      {
-	assert (code != -1);
-	ffecom_f2c_typecode_[bt][j] = code;
-	code = -1;
-      }
-}
-
-/* Finish up globals after doing all program units in file
-
-   Need to handle only uninitialized COMMON areas.  */
-
-static ffeglobal
-ffecom_finish_global_ (ffeglobal global)
-{
-  tree cbtype;
-  tree cbt;
-  tree size;
-
-  if (ffeglobal_type (global) != FFEGLOBAL_typeCOMMON)
-      return global;
-
-  if (ffeglobal_common_init (global))
-      return global;
-
-  cbt = ffeglobal_hook (global);
-  if ((cbt == NULL_TREE)
-      || !ffeglobal_common_have_size (global))
-    return global;		/* No need to make common, never ref'd. */
-
-  DECL_EXTERNAL (cbt) = 0;
-
-  /* Give the array a size now.  */
-
-  size = build_int_2 ((ffeglobal_common_size (global)
-		      + ffeglobal_common_pad (global)) - 1,
-		      0);
-
-  cbtype = TREE_TYPE (cbt);
-  TYPE_DOMAIN (cbtype) = build_range_type (integer_type_node,
-					   integer_zero_node,
-					   size);
-  if (!TREE_TYPE (size))
-    TREE_TYPE (size) = TYPE_DOMAIN (cbtype);
-  layout_type (cbtype);
-
-  cbt = start_decl (cbt, FALSE);
-  assert (cbt == ffeglobal_hook (global));
-
-  finish_decl (cbt, NULL_TREE, FALSE);
-
-  return global;
-}
-
-/* Finish up any untransformed symbols.  */
-
-static ffesymbol
-ffecom_finish_symbol_transform_ (ffesymbol s)
-{
-  if ((s == NULL) || (TREE_CODE (current_function_decl) == ERROR_MARK))
-    return s;
-
-  /* It's easy to know to transform an untransformed symbol, to make sure
-     we put out debugging info for it.  But COMMON variables, unlike
-     EQUIVALENCE ones, aren't given declarations in addition to the
-     tree expressions that specify offsets, because COMMON variables
-     can be referenced in the outer scope where only dummy arguments
-     (PARM_DECLs) should really be seen.  To be safe, just don't do any
-     VAR_DECLs for COMMON variables when we transform them for real
-     use, and therefore we do all the VAR_DECL creating here.  */
-
-  if (ffesymbol_hook (s).decl_tree == NULL_TREE)
-    {
-      if (ffesymbol_kind (s) != FFEINFO_kindNONE
-	  || (ffesymbol_where (s) != FFEINFO_whereNONE
-	      && ffesymbol_where (s) != FFEINFO_whereINTRINSIC
-	      && ffesymbol_where (s) != FFEINFO_whereDUMMY))
-	/* Not transformed, and not CHARACTER*(*), and not a dummy
-	   argument, which can happen only if the entry point names
-	   it "rides in on" are all invalidated for other reasons.  */
-	s = ffecom_sym_transform_ (s);
-    }
-
-  if ((ffesymbol_where (s) == FFEINFO_whereCOMMON)
-      && (ffesymbol_hook (s).decl_tree != error_mark_node))
-    {
-      /* This isn't working, at least for dbxout.  The .s file looks
-	 okay to me (burley), but in gdb 4.9 at least, the variables
-	 appear to reside somewhere outside of the common area, so
-	 it doesn't make sense to mislead anyone by generating the info
-	 on those variables until this is fixed.  NOTE: Same problem
-	 with EQUIVALENCE, sadly...see similar #if later.  */
-      ffecom_member_phase2_ (ffesymbol_storage (ffesymbol_common (s)),
-			     ffesymbol_storage (s));
-    }
-
-  return s;
-}
-
-/* Append underscore(s) to name before calling get_identifier.  "us"
-   is nonzero if the name already contains an underscore and thus
-   needs two underscores appended.  */
-
-static tree
-ffecom_get_appended_identifier_ (char us, const char *name)
-{
-  int i;
-  char *newname;
-  tree id;
-
-  newname = xmalloc ((i = strlen (name)) + 1
-		     + ffe_is_underscoring ()
-		     + us);
-  memcpy (newname, name, i);
-  newname[i] = '_';
-  newname[i + us] = '_';
-  newname[i + 1 + us] = '\0';
-  id = get_identifier (newname);
-
-  free (newname);
-
-  return id;
-}
-
-/* Decide whether to append underscore to name before calling
-   get_identifier.  */
-
-static tree
-ffecom_get_external_identifier_ (ffesymbol s)
-{
-  char us;
-  const char *name = ffesymbol_text (s);
-
-  /* If name is a built-in name, just return it as is.  */
-
-  if (!ffe_is_underscoring ()
-      || (strcmp (name, FFETARGET_nameBLANK_COMMON) == 0)
-      || (strcmp (name, FFETARGET_nameUNNAMED_MAIN) == 0)
-      || (strcmp (name, FFETARGET_nameUNNAMED_BLOCK_DATA) == 0))
-    return get_identifier (name);
-
-  us = ffe_is_second_underscore ()
-    ? (strchr (name, '_') != NULL)
-      : 0;
-
-  return ffecom_get_appended_identifier_ (us, name);
-}
-
-/* Decide whether to append underscore to internal name before calling
-   get_identifier.
-
-   This is for non-external, top-function-context names only.  Transform
-   identifier so it doesn't conflict with the transformed result
-   of using a _different_ external name.  E.g. if "CALL FOO" is
-   transformed into "FOO_();", then the variable in "FOO_ = 3"
-   must be transformed into something that does not conflict, since
-   these two things should be independent.
-
-   The transformation is as follows.  If the name does not contain
-   an underscore, there is no possible conflict, so just return.
-   If the name does contain an underscore, then transform it just
-   like we transform an external identifier.  */
-
-static tree
-ffecom_get_identifier_ (const char *name)
-{
-  /* If name does not contain an underscore, just return it as is.  */
-
-  if (!ffe_is_underscoring ()
-      || (strchr (name, '_') == NULL))
-    return get_identifier (name);
-
-  return ffecom_get_appended_identifier_ (ffe_is_second_underscore (),
-					  name);
-}
-
-/* ffecom_gen_sfuncdef_ -- Generate definition of statement function
-
-   tree t;
-   ffesymbol s;	 // kindFUNCTION, whereIMMEDIATE.
-   t = ffecom_gen_sfuncdef_(s,ffesymbol_basictype(s),
-	 ffesymbol_kindtype(s));
-
-   Call after setting up containing function and getting trees for all
-   other symbols.  */
-
-static tree
-ffecom_gen_sfuncdef_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
-{
-  ffebld expr = ffesymbol_sfexpr (s);
-  tree type;
-  tree func;
-  tree result;
-  bool charfunc = (bt == FFEINFO_basictypeCHARACTER);
-  static bool recurse = FALSE;
-  location_t old_loc = input_location;
-
-  ffecom_nested_entry_ = s;
-
-  /* For now, we don't have a handy pointer to where the sfunc is actually
-     defined, though that should be easy to add to an ffesymbol. (The
-     token/where info available might well point to the place where the type
-     of the sfunc is declared, especially if that precedes the place where
-     the sfunc itself is defined, which is typically the case.)  We should
-     put out a null pointer rather than point somewhere wrong, but I want to
-     see how it works at this point.  */
-
-  input_filename = ffesymbol_where_filename (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. */
-
-  ffecom_expr_transform_ (expr);
-
-  /* Make sure no recursive invocation of this fn (a specific case of failing
-     to pretransform an sfunc's expression, i.e. where its expression
-     references another untransformed sfunc) happens. */
-
-  assert (!recurse);
-  recurse = TRUE;
-
-  push_f_function_context ();
-
-  if (charfunc)
-    type = void_type_node;
-  else
-    {
-      type = ffecom_tree_type[bt][kt];
-      if (type == NULL_TREE)
-	type = integer_type_node;	/* _sym_exec_transition reports
-					   error. */
-    }
-
-  start_function (ffecom_get_identifier_ (ffesymbol_text (s)),
-		  build_function_type (type, NULL_TREE),
-		  1,		/* nested/inline */
-		  0);		/* TREE_PUBLIC */
-
-  /* We don't worry about COMPLEX return values here, because this is
-     entirely internal to our code, and gcc has the ability to return COMPLEX
-     directly as a value.  */
-
-  if (charfunc)
-    {				/* Prepend arg for where result goes. */
-      tree type;
-
-      type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
-
-      result = ffecom_get_invented_identifier ("__g77_%s", "result");
-
-      ffecom_char_enhance_arg_ (&type, s);	/* Ignore returned length. */
-
-      type = build_pointer_type (type);
-      result = build_decl (PARM_DECL, result, type);
-
-      push_parm_decl (result);
-    }
-  else
-    result = NULL_TREE;		/* Not ref'd if !charfunc. */
-
-  ffecom_push_dummy_decls_ (ffesymbol_dummyargs (s), TRUE);
-
-  store_parm_decls (0);
-
-  ffecom_start_compstmt ();
-
-  if (expr != NULL)
-    {
-      if (charfunc)
-	{
-	  ffetargetCharacterSize sz = ffesymbol_size (s);
-	  tree result_length;
-
-	  result_length = build_int_2 (sz, 0);
-	  TREE_TYPE (result_length) = ffecom_f2c_ftnlen_type_node;
-
-	  ffecom_prepare_let_char_ (sz, expr);
-
-	  ffecom_prepare_end ();
-
-	  ffecom_let_char_ (result, result_length, sz, expr);
-	  expand_null_return ();
-	}
-      else
-	{
-	  ffecom_prepare_expr (expr);
-
-	  ffecom_prepare_end ();
-
-	  expand_return (ffecom_modify (NULL_TREE,
-					DECL_RESULT (current_function_decl),
-					ffecom_expr (expr)));
-	}
-    }
-
-  ffecom_end_compstmt ();
-
-  func = current_function_decl;
-  finish_function (1);
-
-  pop_f_function_context ();
-
-  recurse = FALSE;
-
-  input_location = old_loc;
-
-  ffecom_nested_entry_ = NULL;
-
-  return func;
-}
-
-static const char *
-ffecom_gfrt_args_ (ffecomGfrt ix)
-{
-  return ffecom_gfrt_argstring_[ix];
-}
-
-static tree
-ffecom_gfrt_tree_ (ffecomGfrt ix)
-{
-  if (ffecom_gfrt_[ix] == NULL_TREE)
-    ffecom_make_gfrt_ (ix);
-
-  return ffecom_1 (ADDR_EXPR,
-		   build_pointer_type (TREE_TYPE (ffecom_gfrt_[ix])),
-		   ffecom_gfrt_[ix]);
-}
-
-/* Return initialize-to-zero expression for this VAR_DECL.  */
-
-/* A somewhat evil way to prevent the garbage collector
-   from collecting 'tree' structures.  */
-#define NUM_TRACKED_CHUNK 63
-struct tree_ggc_tracker GTY(())
-{
-  struct tree_ggc_tracker *next;
-  tree trees[NUM_TRACKED_CHUNK];
-};
-static GTY(()) struct tree_ggc_tracker *tracker_head;
-
-void
-ffecom_save_tree_forever (tree t)
-{
-  int i;
-  if (tracker_head != NULL)
-    for (i = 0; i < NUM_TRACKED_CHUNK; i++)
-      if (tracker_head->trees[i] == NULL)
-	{
-	  tracker_head->trees[i] = t;
-	  return;
-	}
-
-  {
-    /* Need to allocate a new block.  */
-    struct tree_ggc_tracker *old_head = tracker_head;
-
-    tracker_head = ggc_alloc (sizeof (*tracker_head));
-    tracker_head->next = old_head;
-    tracker_head->trees[0] = t;
-    for (i = 1; i < NUM_TRACKED_CHUNK; i++)
-      tracker_head->trees[i] = NULL;
-  }
-}
-
-static tree
-ffecom_init_zero_ (tree decl)
-{
-  tree init;
-  int incremental = TREE_STATIC (decl);
-  tree type = TREE_TYPE (decl);
-
-  if (incremental)
-    {
-      make_decl_rtl (decl, NULL);
-      assemble_variable (decl, TREE_PUBLIC (decl) ? 1 : 0, 0, 1);
-    }
-
-  if ((TREE_CODE (type) != ARRAY_TYPE)
-      && (TREE_CODE (type) != RECORD_TYPE)
-      && (TREE_CODE (type) != UNION_TYPE)
-      && !incremental)
-    init = convert (type, integer_zero_node);
-  else if (!incremental)
-    {
-      init = build_constructor (type, NULL_TREE);
-      TREE_CONSTANT (init) = 1;
-      TREE_STATIC (init) = 1;
-    }
-  else
-    {
-      assemble_zeros (int_size_in_bytes (type));
-      init = error_mark_node;
-    }
-
-  return init;
-}
-
-static tree
-ffecom_intrinsic_ichar_ (tree tree_type, ffebld arg, tree *maybe_tree)
-{
-  tree expr_tree;
-  tree length_tree;
-
-  switch (ffebld_op (arg))
-    {
-    case FFEBLD_opCONTER:	/* For F90, check 0-length. */
-      if (ffetarget_length_character1
-	  (ffebld_constant_character1
-	   (ffebld_conter (arg))) == 0)
-	{
-	  *maybe_tree = integer_zero_node;
-	  return convert (tree_type, integer_zero_node);
-	}
-
-      *maybe_tree = integer_one_node;
-      expr_tree = build_int_2 (*ffetarget_text_character1
-			       (ffebld_constant_character1
-				(ffebld_conter (arg))),
-			       0);
-      TREE_TYPE (expr_tree) = tree_type;
-      return expr_tree;
-
-    case FFEBLD_opSYMTER:
-    case FFEBLD_opARRAYREF:
-    case FFEBLD_opFUNCREF:
-    case FFEBLD_opSUBSTR:
-      ffecom_char_args_ (&expr_tree, &length_tree, arg);
-
-      if ((expr_tree == error_mark_node)
-	  || (length_tree == error_mark_node))
-	{
-	  *maybe_tree = error_mark_node;
-	  return error_mark_node;
-	}
-
-      if (integer_zerop (length_tree))
-	{
-	  *maybe_tree = integer_zero_node;
-	  return convert (tree_type, integer_zero_node);
-	}
-
-      expr_tree
-	= ffecom_1 (INDIRECT_REF,
-		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
-		    expr_tree);
-      expr_tree
-	= ffecom_2 (ARRAY_REF,
-		    TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (expr_tree))),
-		    expr_tree,
-		    integer_one_node);
-      expr_tree = convert (tree_type, expr_tree);
-
-      if (TREE_CODE (length_tree) == INTEGER_CST)
-	*maybe_tree = integer_one_node;
-      else			/* Must check length at run time.  */
-	*maybe_tree
-	  = ffecom_truth_value
-	    (ffecom_2 (GT_EXPR, integer_type_node,
-		       length_tree,
-		       ffecom_f2c_ftnlen_zero_node));
-      return expr_tree;
-
-    case FFEBLD_opPAREN:
-    case FFEBLD_opCONVERT:
-      if (ffeinfo_size (ffebld_info (arg)) == 0)
-	{
-	  *maybe_tree = integer_zero_node;
-	  return convert (tree_type, integer_zero_node);
-	}
-      return ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg),
-				      maybe_tree);
-
-    case FFEBLD_opCONCATENATE:
-      {
-	tree maybe_left;
-	tree maybe_right;
-	tree expr_left;
-	tree expr_right;
-
-	expr_left = ffecom_intrinsic_ichar_ (tree_type, ffebld_left (arg),
-					     &maybe_left);
-	expr_right = ffecom_intrinsic_ichar_ (tree_type, ffebld_right (arg),
-					      &maybe_right);
-	*maybe_tree = ffecom_2 (TRUTH_ORIF_EXPR, integer_type_node,
-				maybe_left,
-				maybe_right);
-	expr_tree = ffecom_3 (COND_EXPR, tree_type,
-			      maybe_left,
-			      expr_left,
-			      expr_right);
-	return expr_tree;
-      }
-
-    default:
-      assert ("bad op in ICHAR" == NULL);
-      return error_mark_node;
-    }
-}
-
-/* ffecom_intrinsic_len_ -- Return length info for char arg (LEN())
-
-   tree length_arg;
-   ffebld expr;
-   length_arg = ffecom_intrinsic_len_ (expr);
-
-   Handles CHARACTER-type CONTER, SYMTER, SUBSTR, ARRAYREF, and FUNCREF
-   subexpressions by constructing the appropriate tree for the
-   length-of-character-text argument in a calling sequence.  */
-
-static tree
-ffecom_intrinsic_len_ (ffebld expr)
-{
-  ffetargetCharacter1 val;
-  tree length;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opCONTER:
-      val = ffebld_constant_character1 (ffebld_conter (expr));
-      length = build_int_2 (ffetarget_length_character1 (val), 0);
-      TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
-      break;
-
-    case FFEBLD_opSYMTER:
-      {
-	ffesymbol s = ffebld_symter (expr);
-	tree item;
-
-	item = ffesymbol_hook (s).decl_tree;
-	if (item == NULL_TREE)
-	  {
-	    s = ffecom_sym_transform_ (s);
-	    item = ffesymbol_hook (s).decl_tree;
-	  }
-	if (ffesymbol_kind (s) == FFEINFO_kindENTITY)
-	  {
-	    if (ffesymbol_size (s) == FFETARGET_charactersizeNONE)
-	      length = ffesymbol_hook (s).length_tree;
-	    else
-	      {
-		length = build_int_2 (ffesymbol_size (s), 0);
-		TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
-	      }
-	  }
-	else if (item == error_mark_node)
-	  length = error_mark_node;
-	else			/* FFEINFO_kindFUNCTION: */
-	  length = NULL_TREE;
-      }
-      break;
-
-    case FFEBLD_opARRAYREF:
-      length = ffecom_intrinsic_len_ (ffebld_left (expr));
-      break;
-
-    case FFEBLD_opSUBSTR:
-      {
-	ffebld start;
-	ffebld end;
-	ffebld thing = ffebld_right (expr);
-	tree start_tree;
-	tree end_tree;
-
-	assert (ffebld_op (thing) == FFEBLD_opITEM);
-	start = ffebld_head (thing);
-	thing = ffebld_trail (thing);
-	assert (ffebld_trail (thing) == NULL);
-	end = ffebld_head (thing);
-
-	length = ffecom_intrinsic_len_ (ffebld_left (expr));
-
-	if (length == error_mark_node)
-	  break;
-
-	if (start == NULL)
-	  {
-	    if (end == NULL)
-	      ;
-	    else
-	      {
-		length = convert (ffecom_f2c_ftnlen_type_node,
-				  ffecom_expr (end));
-	      }
-	  }
-	else
-	  {
-	    start_tree = convert (ffecom_f2c_ftnlen_type_node,
-				  ffecom_expr (start));
-
-	    if (start_tree == error_mark_node)
-	      {
-		length = error_mark_node;
-		break;
-	      }
-
-	    if (end == NULL)
-	      {
-		length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-				   ffecom_f2c_ftnlen_one_node,
-				   ffecom_2 (MINUS_EXPR,
-					     ffecom_f2c_ftnlen_type_node,
-					     length,
-					     start_tree));
-	      }
-	    else
-	      {
-		end_tree = convert (ffecom_f2c_ftnlen_type_node,
-				    ffecom_expr (end));
-
-		if (end_tree == error_mark_node)
-		  {
-		    length = error_mark_node;
-		    break;
-		  }
-
-		length = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-				   ffecom_f2c_ftnlen_one_node,
-				   ffecom_2 (MINUS_EXPR,
-					     ffecom_f2c_ftnlen_type_node,
-					     end_tree, start_tree));
-	      }
-	  }
-      }
-      break;
-
-    case FFEBLD_opCONCATENATE:
-      length
-	= ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-		    ffecom_intrinsic_len_ (ffebld_left (expr)),
-		    ffecom_intrinsic_len_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opFUNCREF:
-    case FFEBLD_opCONVERT:
-      length = build_int_2 (ffebld_size (expr), 0);
-      TREE_TYPE (length) = ffecom_f2c_ftnlen_type_node;
-      break;
-
-    default:
-      assert ("bad op for single char arg expr" == NULL);
-      length = ffecom_f2c_ftnlen_zero_node;
-      break;
-    }
-
-  assert (length != NULL_TREE);
-
-  return length;
-}
-
-/* Handle CHARACTER assignments.
-
-   Generates code to do the assignment.	 Used by ordinary assignment
-   statement handler ffecom_let_stmt and by statement-function
-   handler to generate code for a statement function.  */
-
-static void
-ffecom_let_char_ (tree dest_tree, tree dest_length,
-		  ffetargetCharacterSize dest_size, ffebld source)
-{
-  ffecomConcatList_ catlist;
-  tree source_length;
-  tree source_tree;
-  tree expr_tree;
-
-  if ((dest_tree == error_mark_node)
-      || (dest_length == error_mark_node))
-    return;
-
-  assert (dest_tree != NULL_TREE);
-  assert (dest_length != NULL_TREE);
-
-  /* Source might be an opCONVERT, which just means it is a different size
-     than the destination.  Since the underlying implementation here handles
-     that (directly or via the s_copy or s_cat run-time-library functions),
-     we don't need the "convenience" of an opCONVERT that tells us to
-     truncate or blank-pad, particularly since the resulting implementation
-     would probably be slower than otherwise. */
-
-  while (ffebld_op (source) == FFEBLD_opCONVERT)
-    source = ffebld_left (source);
-
-  catlist = ffecom_concat_list_new_ (source, dest_size);
-  switch (ffecom_concat_list_count_ (catlist))
-    {
-    case 0:			/* Shouldn't happen, but in case it does... */
-      ffecom_concat_list_kill_ (catlist);
-      source_tree = null_pointer_node;
-      source_length = ffecom_f2c_ftnlen_zero_node;
-      expr_tree = build_tree_list (NULL_TREE, dest_tree);
-      TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree);
-      TREE_CHAIN (TREE_CHAIN (expr_tree))
-	= build_tree_list (NULL_TREE, dest_length);
-      TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
-	= build_tree_list (NULL_TREE, source_length);
-
-      expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE);
-      TREE_SIDE_EFFECTS (expr_tree) = 1;
-
-      expand_expr_stmt (expr_tree);
-
-      return;
-
-    case 1:			/* The (fairly) easy case. */
-      ffecom_char_args_ (&source_tree, &source_length,
-			 ffecom_concat_list_expr_ (catlist, 0));
-      ffecom_concat_list_kill_ (catlist);
-      assert (source_tree != NULL_TREE);
-      assert (source_length != NULL_TREE);
-
-      if ((source_tree == error_mark_node)
-	  || (source_length == error_mark_node))
-	return;
-
-      if (dest_size == 1)
-	{
-	  dest_tree
-	    = ffecom_1 (INDIRECT_REF,
-			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
-						      (dest_tree))),
-			dest_tree);
-	  dest_tree
-	    = ffecom_2 (ARRAY_REF,
-			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
-						      (dest_tree))),
-			dest_tree,
-			integer_one_node);
-	  source_tree
-	    = ffecom_1 (INDIRECT_REF,
-			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
-						      (source_tree))),
-			source_tree);
-	  source_tree
-	    = ffecom_2 (ARRAY_REF,
-			TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE
-						      (source_tree))),
-			source_tree,
-			integer_one_node);
-
-	  expr_tree = ffecom_modify (void_type_node, dest_tree, source_tree);
-
-	  expand_expr_stmt (expr_tree);
-
-	  return;
-	}
-
-      expr_tree = build_tree_list (NULL_TREE, dest_tree);
-      TREE_CHAIN (expr_tree) = build_tree_list (NULL_TREE, source_tree);
-      TREE_CHAIN (TREE_CHAIN (expr_tree))
-	= build_tree_list (NULL_TREE, dest_length);
-      TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
-	= build_tree_list (NULL_TREE, source_length);
-
-      expr_tree = ffecom_call_gfrt (FFECOM_gfrtCOPY, expr_tree, NULL_TREE);
-      TREE_SIDE_EFFECTS (expr_tree) = 1;
-
-      expand_expr_stmt (expr_tree);
-
-      return;
-
-    default:			/* Must actually concatenate things. */
-      break;
-    }
-
-  /* Heavy-duty concatenation. */
-
-  {
-    int count = ffecom_concat_list_count_ (catlist);
-    int i;
-    tree lengths;
-    tree items;
-    tree length_array;
-    tree item_array;
-    tree citem;
-    tree clength;
-
-    {
-      tree hook;
-
-      hook = ffebld_nonter_hook (source);
-      assert (hook);
-      assert (TREE_CODE (hook) == TREE_VEC);
-      assert (TREE_VEC_LENGTH (hook) == 2);
-      length_array = lengths = TREE_VEC_ELT (hook, 0);
-      item_array = items = TREE_VEC_ELT (hook, 1);
-    }
-
-    for (i = 0; i < count; ++i)
-      {
-	ffecom_char_args_ (&citem, &clength,
-			   ffecom_concat_list_expr_ (catlist, i));
-	if ((citem == error_mark_node)
-	    || (clength == error_mark_node))
-	  {
-	    ffecom_concat_list_kill_ (catlist);
-	    return;
-	  }
-
-	items
-	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items),
-		      ffecom_modify (void_type_node,
-				     ffecom_2 (ARRAY_REF,
-		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))),
-					       item_array,
-					       build_int_2 (i, 0)),
-				     citem),
-		      items);
-	lengths
-	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
-		      ffecom_modify (void_type_node,
-				     ffecom_2 (ARRAY_REF,
-		   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))),
-					       length_array,
-					       build_int_2 (i, 0)),
-				     clength),
-		      lengths);
-      }
-
-    expr_tree = build_tree_list (NULL_TREE, dest_tree);
-    TREE_CHAIN (expr_tree)
-      = build_tree_list (NULL_TREE,
-			 ffecom_1 (ADDR_EXPR,
-				   build_pointer_type (TREE_TYPE (items)),
-				   items));
-    TREE_CHAIN (TREE_CHAIN (expr_tree))
-      = build_tree_list (NULL_TREE,
-			 ffecom_1 (ADDR_EXPR,
-				   build_pointer_type (TREE_TYPE (lengths)),
-				   lengths));
-    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree)))
-      = build_tree_list
-	(NULL_TREE,
-	 ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
-		   convert (ffecom_f2c_ftnlen_type_node,
-			    build_int_2 (count, 0))));
-    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (expr_tree))))
-      = build_tree_list (NULL_TREE, dest_length);
-
-    expr_tree = ffecom_call_gfrt (FFECOM_gfrtCAT, expr_tree, NULL_TREE);
-    TREE_SIDE_EFFECTS (expr_tree) = 1;
-
-    expand_expr_stmt (expr_tree);
-  }
-
-  ffecom_concat_list_kill_ (catlist);
-}
-
-/* ffecom_make_gfrt_ -- Make initial info for run-time routine
-
-   ffecomGfrt ix;
-   ffecom_make_gfrt_(ix);
-
-   Assumes gfrt_[ix] is NULL_TREE, and replaces it with the FUNCTION_DECL
-   for the indicated run-time routine (ix).  */
-
-static void
-ffecom_make_gfrt_ (ffecomGfrt ix)
-{
-  tree t;
-  tree ttype;
-
-  switch (ffecom_gfrt_type_[ix])
-    {
-    case FFECOM_rttypeVOID_:
-      ttype = void_type_node;
-      break;
-
-    case FFECOM_rttypeVOIDSTAR_:
-      ttype = TREE_TYPE (null_pointer_node);	/* `void *'. */
-      break;
-
-    case FFECOM_rttypeFTNINT_:
-      ttype = ffecom_f2c_ftnint_type_node;
-      break;
-
-    case FFECOM_rttypeINTEGER_:
-      ttype = ffecom_f2c_integer_type_node;
-      break;
-
-    case FFECOM_rttypeLONGINT_:
-      ttype = ffecom_f2c_longint_type_node;
-      break;
-
-    case FFECOM_rttypeLOGICAL_:
-      ttype = ffecom_f2c_logical_type_node;
-      break;
-
-    case FFECOM_rttypeREAL_F2C_:
-      ttype = double_type_node;
-      break;
-
-    case FFECOM_rttypeREAL_GNU_:
-      ttype = float_type_node;
-      break;
-
-    case FFECOM_rttypeCOMPLEX_F2C_:
-      ttype = void_type_node;
-      break;
-
-    case FFECOM_rttypeCOMPLEX_GNU_:
-      ttype = ffecom_f2c_complex_type_node;
-      break;
-
-    case FFECOM_rttypeDOUBLE_:
-      ttype = double_type_node;
-      break;
-
-    case FFECOM_rttypeDOUBLEREAL_:
-      ttype = ffecom_f2c_doublereal_type_node;
-      break;
-
-    case FFECOM_rttypeDBLCMPLX_F2C_:
-      ttype = void_type_node;
-      break;
-
-    case FFECOM_rttypeDBLCMPLX_GNU_:
-      ttype = ffecom_f2c_doublecomplex_type_node;
-      break;
-
-    case FFECOM_rttypeCHARACTER_:
-      ttype = void_type_node;
-      break;
-
-    default:
-      ttype = NULL;
-      assert ("bad rttype" == NULL);
-      break;
-    }
-
-  ttype = build_function_type (ttype, NULL_TREE);
-  t = build_decl (FUNCTION_DECL,
-		  get_identifier (ffecom_gfrt_name_[ix]),
-		  ttype);
-  DECL_EXTERNAL (t) = 1;
-  TREE_READONLY (t) = ffecom_gfrt_const_[ix] ? 1 : 0;
-  TREE_PUBLIC (t) = 1;
-  TREE_THIS_VOLATILE (t) = ffecom_gfrt_volatile_[ix] ? 1 : 0;
-
-  /* Sanity check:  A function that's const cannot be volatile.  */
-
-  assert (ffecom_gfrt_const_[ix] ? !ffecom_gfrt_volatile_[ix] : 1);
-
-  /* Sanity check: A function that's const cannot return complex.  */
-
-  assert (ffecom_gfrt_const_[ix] ? !ffecom_gfrt_complex_[ix] : 1);
-
-  t = start_decl (t, TRUE);
-
-  finish_decl (t, NULL_TREE, TRUE);
-
-  ffecom_gfrt_[ix] = t;
-}
-
-/* Phase 1 pass over each member of a COMMON/EQUIVALENCE group.  */
-
-static void
-ffecom_member_phase1_ (ffestorag mst UNUSED, ffestorag st)
-{
-  ffesymbol s = ffestorag_symbol (st);
-
-  if (ffesymbol_namelisted (s))
-    ffecom_member_namelisted_ = TRUE;
-}
-
-/* Phase 2 pass over each member of a COMMON/EQUIVALENCE group.  Declare
-   the member so debugger will see it.  Otherwise nobody should be
-   referencing the member.  */
-
-static void
-ffecom_member_phase2_ (ffestorag mst, ffestorag st)
-{
-  ffesymbol s;
-  tree t;
-  tree mt;
-  tree type;
-
-  if ((mst == NULL)
-      || ((mt = ffestorag_hook (mst)) == NULL)
-      || (mt == error_mark_node))
-    return;
-
-  if ((st == NULL)
-      || ((s = ffestorag_symbol (st)) == NULL))
-    return;
-
-  type = ffecom_type_localvar_ (s,
-				ffesymbol_basictype (s),
-				ffesymbol_kindtype (s));
-  if (type == error_mark_node)
-    return;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_identifier_ (ffesymbol_text (s)),
-		  type);
-
-  TREE_STATIC (t) = TREE_STATIC (mt);
-  DECL_INITIAL (t) = NULL_TREE;
-  TREE_ASM_WRITTEN (t) = 1;
-  TREE_USED (t) = 1;
-
-  SET_DECL_RTL (t,
-		gen_rtx_MEM (TYPE_MODE (type),
-			     plus_constant (XEXP (DECL_RTL (mt), 0),
-					    ffestorag_modulo (mst)
-					    + ffestorag_offset (st)
-					    - ffestorag_offset (mst))));
-
-  t = start_decl (t, FALSE);
-
-  finish_decl (t, NULL_TREE, FALSE);
-}
-
-/* Prepare source expression for assignment into a destination perhaps known
-   to be of a specific size.  */
-
-static void
-ffecom_prepare_let_char_ (ffetargetCharacterSize dest_size, ffebld source)
-{
-  ffecomConcatList_ catlist;
-  int count;
-  int i;
-  tree ltmp;
-  tree itmp;
-  tree tempvar = NULL_TREE;
-
-  while (ffebld_op (source) == FFEBLD_opCONVERT)
-    source = ffebld_left (source);
-
-  catlist = ffecom_concat_list_new_ (source, dest_size);
-  count = ffecom_concat_list_count_ (catlist);
-
-  if (count >= 2)
-    {
-      ltmp
-	= ffecom_make_tempvar ("let_char_len", ffecom_f2c_ftnlen_type_node,
-			       FFETARGET_charactersizeNONE, count);
-      itmp
-	= ffecom_make_tempvar ("let_char_item", ffecom_f2c_address_type_node,
-			       FFETARGET_charactersizeNONE, count);
-
-      tempvar = make_tree_vec (2);
-      TREE_VEC_ELT (tempvar, 0) = ltmp;
-      TREE_VEC_ELT (tempvar, 1) = itmp;
-    }
-
-  for (i = 0; i < count; ++i)
-    ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist, i));
-
-  ffecom_concat_list_kill_ (catlist);
-
-  if (tempvar)
-    {
-      ffebld_nonter_set_hook (source, tempvar);
-      current_binding_level->prep_state = 1;
-    }
-}
-
-/* ffecom_push_dummy_decls_ -- Transform dummy args, push parm decls in order
-
-   Ignores STAR (alternate-return) dummies.  All other get exec-transitioned
-   (which generates their trees) and then their trees get push_parm_decl'd.
-
-   The second arg is TRUE if the dummies are for a statement function, in
-   which case lengths are not pushed for character arguments (since they are
-   always known by both the caller and the callee, though the code allows
-   for someday permitting CHAR*(*) stmtfunc dummies).  */
-
-static void
-ffecom_push_dummy_decls_ (ffebld dummy_list, bool stmtfunc)
-{
-  ffebld dummy;
-  ffebld dumlist;
-  ffesymbol s;
-  tree parm;
-
-  ffecom_transform_only_dummies_ = TRUE;
-
-  /* First push the parms corresponding to actual dummy "contents".  */
-
-  for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist))
-    {
-      dummy = ffebld_head (dumlist);
-      switch (ffebld_op (dummy))
-	{
-	case FFEBLD_opSTAR:
-	case FFEBLD_opANY:
-	  continue;		/* Forget alternate returns. */
-
-	default:
-	  break;
-	}
-      assert (ffebld_op (dummy) == FFEBLD_opSYMTER);
-      s = ffebld_symter (dummy);
-      parm = ffesymbol_hook (s).decl_tree;
-      if (parm == NULL_TREE)
-	{
-	  s = ffecom_sym_transform_ (s);
-	  parm = ffesymbol_hook (s).decl_tree;
-	  assert (parm != NULL_TREE);
-	}
-      if (parm != error_mark_node)
-	push_parm_decl (parm);
-    }
-
-  /* Then, for CHARACTER dummies, push the parms giving their lengths.  */
-
-  for (dumlist = dummy_list; dumlist != NULL; dumlist = ffebld_trail (dumlist))
-    {
-      dummy = ffebld_head (dumlist);
-      switch (ffebld_op (dummy))
-	{
-	case FFEBLD_opSTAR:
-	case FFEBLD_opANY:
-	  continue;		/* Forget alternate returns, they mean
-				   NOTHING! */
-
-	default:
-	  break;
-	}
-      s = ffebld_symter (dummy);
-      if (ffesymbol_basictype (s) != FFEINFO_basictypeCHARACTER)
-	continue;		/* Only looking for CHARACTER arguments. */
-      if (stmtfunc && (ffesymbol_size (s) != FFETARGET_charactersizeNONE))
-	continue;		/* Stmtfunc arg with known size needs no
-				   length param. */
-      if (ffesymbol_kind (s) != FFEINFO_kindENTITY)
-	continue;		/* Only looking for variables and arrays. */
-      parm = ffesymbol_hook (s).length_tree;
-      assert (parm != NULL_TREE);
-      if (parm != error_mark_node)
-	push_parm_decl (parm);
-    }
-
-  ffecom_transform_only_dummies_ = FALSE;
-}
-
-/* ffecom_start_progunit_ -- Beginning of program unit
-
-   Does GNU back end stuff necessary to teach it about the start of its
-   equivalent of a Fortran program unit.  */
-
-static void
-ffecom_start_progunit_ (void)
-{
-  ffesymbol fn = ffecom_primary_entry_;
-  ffebld arglist;
-  tree id;			/* Identifier (name) of function. */
-  tree type;			/* Type of function. */
-  tree result;			/* Result of function. */
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffeglobal g;
-  ffeglobalType gt;
-  ffeglobalType egt = FFEGLOBAL_type;
-  bool charfunc;
-  bool cmplxfunc;
-  bool altentries = (ffecom_num_entrypoints_ != 0);
-  bool multi
-  = altentries
-  && (ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
-  && (ffecom_master_bt_ == FFEINFO_basictypeNONE);
-  bool main_program = FALSE;
-  location_t old_loc = input_location;
-
-  assert (fn != NULL);
-  assert (ffesymbol_hook (fn).decl_tree == NULL_TREE);
-
-  input_filename = ffesymbol_where_filename (fn);
-  input_line = ffesymbol_where_filelinenum (fn);
-
-  switch (ffecom_primary_entry_kind_)
-    {
-    case FFEINFO_kindPROGRAM:
-      main_program = TRUE;
-      gt = FFEGLOBAL_typeMAIN;
-      bt = FFEINFO_basictypeNONE;
-      kt = FFEINFO_kindtypeNONE;
-      type = ffecom_tree_fun_type_void;
-      charfunc = FALSE;
-      cmplxfunc = FALSE;
-      break;
-
-    case FFEINFO_kindBLOCKDATA:
-      gt = FFEGLOBAL_typeBDATA;
-      bt = FFEINFO_basictypeNONE;
-      kt = FFEINFO_kindtypeNONE;
-      type = ffecom_tree_fun_type_void;
-      charfunc = FALSE;
-      cmplxfunc = FALSE;
-      break;
-
-    case FFEINFO_kindFUNCTION:
-      gt = FFEGLOBAL_typeFUNC;
-      egt = FFEGLOBAL_typeEXT;
-      bt = ffesymbol_basictype (fn);
-      kt = ffesymbol_kindtype (fn);
-      if (bt == FFEINFO_basictypeNONE)
-	{
-	  ffeimplic_establish_symbol (fn);
-	  if (ffesymbol_funcresult (fn) != NULL)
-	    ffeimplic_establish_symbol (ffesymbol_funcresult (fn));
-	  bt = ffesymbol_basictype (fn);
-	  kt = ffesymbol_kindtype (fn);
-	}
-
-      if (multi)
-	charfunc = cmplxfunc = FALSE;
-      else if (bt == FFEINFO_basictypeCHARACTER)
-	charfunc = TRUE, cmplxfunc = FALSE;
-      else if ((bt == FFEINFO_basictypeCOMPLEX)
-	       && ffesymbol_is_f2c (fn)
-	       && !altentries)
-	charfunc = FALSE, cmplxfunc = TRUE;
-      else
-	charfunc = cmplxfunc = FALSE;
-
-      if (multi || charfunc)
-	type = ffecom_tree_fun_type_void;
-      else if (ffesymbol_is_f2c (fn) && !altentries)
-	type = ffecom_tree_fun_type[bt][kt];
-      else
-	type = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
-
-      if ((type == NULL_TREE)
-	  || (TREE_TYPE (type) == NULL_TREE))
-	type = ffecom_tree_fun_type_void;	/* _sym_exec_transition. */
-      break;
-
-    case FFEINFO_kindSUBROUTINE:
-      gt = FFEGLOBAL_typeSUBR;
-      egt = FFEGLOBAL_typeEXT;
-      bt = FFEINFO_basictypeNONE;
-      kt = FFEINFO_kindtypeNONE;
-      if (ffecom_is_altreturning_)
-	type = ffecom_tree_subr_type;
-      else
-	type = ffecom_tree_fun_type_void;
-      charfunc = FALSE;
-      cmplxfunc = FALSE;
-      break;
-
-    default:
-      assert ("say what??" == NULL);
-      /* Fall through. */
-    case FFEINFO_kindANY:
-      gt = FFEGLOBAL_typeANY;
-      bt = FFEINFO_basictypeNONE;
-      kt = FFEINFO_kindtypeNONE;
-      type = error_mark_node;
-      charfunc = FALSE;
-      cmplxfunc = FALSE;
-      break;
-    }
-
-  if (altentries)
-    {
-      id = ffecom_get_invented_identifier ("__g77_masterfun_%s",
-					   ffesymbol_text (fn));
-    }
-#if FFETARGET_isENFORCED_MAIN
-  else if (main_program)
-    id = get_identifier (FFETARGET_nameENFORCED_MAIN_NAME);
-#endif
-  else
-    id = ffecom_get_external_identifier_ (fn);
-
-  start_function (id,
-		  type,
-		  0,		/* nested/inline */
-		  !altentries);	/* TREE_PUBLIC */
-
-  TREE_USED (current_function_decl) = 1;	/* Avoid spurious warning if altentries. */
-
-  if (!altentries
-      && ((g = ffesymbol_global (fn)) != NULL)
-      && ((ffeglobal_type (g) == gt)
-	  || (ffeglobal_type (g) == egt)))
-    {
-      ffeglobal_set_hook (g, current_function_decl);
-    }
-
-  /* Arg handling needs exec-transitioned ffesymbols to work with.  But
-     exec-transitioning needs current_function_decl to be filled in.  So we
-     do these things in two phases. */
-
-  if (altentries)
-    {				/* 1st arg identifies which entrypoint. */
-      ffecom_which_entrypoint_decl_
-	= build_decl (PARM_DECL,
-		      ffecom_get_invented_identifier ("__g77_%s",
-						      "which_entrypoint"),
-		      integer_type_node);
-      push_parm_decl (ffecom_which_entrypoint_decl_);
-    }
-
-  if (charfunc
-      || cmplxfunc
-      || multi)
-    {				/* Arg for result (return value). */
-      tree type;
-      tree length;
-
-      if (charfunc)
-	type = ffecom_tree_type[FFEINFO_basictypeCHARACTER][kt];
-      else if (cmplxfunc)
-	type = ffecom_tree_type[FFEINFO_basictypeCOMPLEX][kt];
-      else
-	type = ffecom_multi_type_node_;
-
-      result = ffecom_get_invented_identifier ("__g77_%s", "result");
-
-      /* Make length arg _and_ enhance type info for CHAR arg itself.  */
-
-      if (charfunc)
-	length = ffecom_char_enhance_arg_ (&type, fn);
-      else
-	length = NULL_TREE;	/* Not ref'd if !charfunc. */
-
-      type = build_pointer_type (type);
-      result = build_decl (PARM_DECL, result, type);
-
-      push_parm_decl (result);
-      if (multi)
-	ffecom_multi_retval_ = result;
-      else
-	ffecom_func_result_ = result;
-
-      if (charfunc)
-	{
-	  push_parm_decl (length);
-	  ffecom_func_length_ = length;
-	}
-    }
-
-  if (ffecom_primary_entry_is_proc_)
-    {
-      if (altentries)
-	arglist = ffecom_master_arglist_;
-      else
-	arglist = ffesymbol_dummyargs (fn);
-      ffecom_push_dummy_decls_ (arglist, FALSE);
-    }
-
-  if (TREE_CODE (current_function_decl) != ERROR_MARK)
-    store_parm_decls (main_program ? 1 : 0);
-
-  ffecom_start_compstmt ();
-  /* Disallow temp vars at this level.  */
-  current_binding_level->prep_state = 2;
-
-  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
-     be necessary to do it here so that statement functions are
-     expanded before code.  But don't bother for BLOCK DATA.  */
-
-  if (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)
-    ffesymbol_drive (ffecom_finish_symbol_transform_);
-}
-
-/* ffecom_sym_transform_ -- Transform FFE sym into backend sym
-
-   ffesymbol s;
-   ffecom_sym_transform_(s);
-
-   The ffesymbol_hook info for s is updated with appropriate backend info
-   on the symbol.  */
-
-static ffesymbol
-ffecom_sym_transform_ (ffesymbol s)
-{
-  tree t;			/* Transformed thingy. */
-  tree tlen;			/* Length if CHAR*(*). */
-  bool addr;			/* Is t the address of the thingy? */
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffeglobal g;
-  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
-     ASSIGN is seen, which leaves them out of scope when they're the
-     subject of a GOTO or I/O statement.
-
-     We make this variable even if -fugly-assign.  Just let it go unused,
-     in case it turns out there are cases where we really want to use this
-     variable anyway (e.g. ASSIGN to INTEGER*2 variable).  */
-
-  if (! ffecom_transform_only_dummies_
-      && ffesymbol_assigned (s)
-      && ! ffesymbol_hook (s).assign_tree)
-    s = ffecom_sym_transform_assign_ (s);
-
-  if (ffesymbol_sfdummyparent (s) == NULL)
-    {
-      input_filename = ffesymbol_where_filename (s);
-      input_line = ffesymbol_where_filelinenum (s);
-    }
-  else
-    {
-      ffesymbol sf = ffesymbol_sfdummyparent (s);
-
-      input_filename = ffesymbol_where_filename (sf);
-      input_line = ffesymbol_where_filelinenum (sf);
-    }
-
-  bt = ffeinfo_basictype (ffebld_info (s));
-  kt = ffeinfo_kindtype (ffebld_info (s));
-
-  t = NULL_TREE;
-  tlen = NULL_TREE;
-  addr = FALSE;
-
-  switch (ffesymbol_kind (s))
-    {
-    case FFEINFO_kindNONE:
-      switch (ffesymbol_where (s))
-	{
-	case FFEINFO_whereDUMMY:	/* Subroutine or function. */
-	  assert (ffecom_transform_only_dummies_);
-
-	  /* Before 0.4, this could be ENTITY/DUMMY, but see
-	     ffestu_sym_end_transition -- no longer true (in particular, if
-	     it could be an ENTITY, it _will_ be made one, so that
-	     possibility won't come through here).  So we never make length
-	     arg for CHARACTER type.  */
-
-	  t = build_decl (PARM_DECL,
-			  ffecom_get_identifier_ (ffesymbol_text (s)),
-			  ffecom_tree_ptr_to_subr_type);
-	  DECL_ARTIFICIAL (t) = 1;
-	  addr = TRUE;
-	  break;
-
-	case FFEINFO_whereGLOBAL:	/* Subroutine or function. */
-	  assert (!ffecom_transform_only_dummies_);
-
-	  if (((g = ffesymbol_global (s)) != NULL)
-	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
-	      && (ffeglobal_hook (g) != NULL_TREE)
-	      && ffe_is_globals ())
-	    {
-	      t = ffeglobal_hook (g);
-	      break;
-	    }
-
-	  t = build_decl (FUNCTION_DECL,
-			  ffecom_get_external_identifier_ (s),
-			  ffecom_tree_subr_type);	/* Assume subr. */
-	  DECL_EXTERNAL (t) = 1;
-	  TREE_PUBLIC (t) = 1;
-
-	  t = start_decl (t, FALSE);
-	  finish_decl (t, NULL_TREE, FALSE);
-
-	  if ((g != NULL)
-	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
-	    ffeglobal_set_hook (g, t);
-
-	  ffecom_save_tree_forever (t);
-
-	  break;
-
-	default:
-	  assert ("NONE where unexpected" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindENTITY:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-
-	case FFEINFO_whereCONSTANT:
-	  /* ~~Debugging info needed? */
-	  assert (!ffecom_transform_only_dummies_);
-	  t = error_mark_node;	/* Shouldn't ever see this in expr. */
-	  break;
-
-	case FFEINFO_whereLOCAL:
-	  assert (!ffecom_transform_only_dummies_);
-
-	  {
-	    ffestorag st = ffesymbol_storage (s);
-	    tree type;
-
-	    type = ffecom_type_localvar_ (s, bt, kt);
-
-	    if (type == error_mark_node)
-	      {
-		t = error_mark_node;
-		break;
-	      }
-
-	    if ((st != NULL)
-		&& (ffestorag_size (st) == 0))
-	      {
-		t = error_mark_node;
-		break;
-	      }
-
-	    if ((st != NULL)
-		&& (ffestorag_parent (st) != NULL))
-	      {			/* Child of EQUIVALENCE parent. */
-		ffestorag est;
-		tree et;
-		ffetargetOffset offset;
-
-		est = ffestorag_parent (st);
-		ffecom_transform_equiv_ (est);
-
-		et = ffestorag_hook (est);
-		assert (et != NULL_TREE);
-
-		if (! TREE_STATIC (et))
-		  put_var_into_stack (et, /*rescan=*/true);
-
-		offset = ffestorag_modulo (est)
-		  + ffestorag_offset (ffesymbol_storage (s))
-		  - ffestorag_offset (est);
-
-		ffecom_debug_kludge_ (et, "EQUIVALENCE", s, type, offset);
-
-		/* (t_type *) (((char *) &et) + offset) */
-
-		t = convert (string_type_node,	/* (char *) */
-			     ffecom_1 (ADDR_EXPR,
-				       build_pointer_type (TREE_TYPE (et)),
-				       et));
-		t = ffecom_2 (PLUS_EXPR, TREE_TYPE (t),
-			      t,
-			      build_int_2 (offset, 0));
-		t = convert (build_pointer_type (type),
-			     t);
-		TREE_CONSTANT (t) = staticp (et);
-
-		addr = TRUE;
-	      }
-	    else
-	      {
-		tree initexpr;
-		bool init = ffesymbol_is_init (s);
-
-		t = build_decl (VAR_DECL,
-				ffecom_get_identifier_ (ffesymbol_text (s)),
-				type);
-
-		if (init
-		    || ffesymbol_namelisted (s)
-#ifdef FFECOM_sizeMAXSTACKITEM
-		    || ((st != NULL)
-			&& (ffestorag_size (st) > FFECOM_sizeMAXSTACKITEM))
-#endif
-		    || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
-			&& (ffecom_primary_entry_kind_
-			    != FFEINFO_kindBLOCKDATA)
-			&& (ffesymbol_is_save (s) || ffe_is_saveall ())))
-		  TREE_STATIC (t) = !ffesymbol_attr (s, FFESYMBOL_attrADJUSTABLE);
-		else
-		  TREE_STATIC (t) = 0;	/* No need to make static. */
-
-		if (init || ffe_is_init_local_zero ())
-		  DECL_INITIAL (t) = error_mark_node;
-
-		/* Keep -Wunused from complaining about var if it
-		   is used as sfunc arg or DATA implied-DO.  */
-		if (ffesymbol_attrs (s) & FFESYMBOL_attrsSFARG)
-		  DECL_IN_SYSTEM_HEADER (t) = 1;
-
-		t = start_decl (t, FALSE);
-
-		if (init)
-		  {
-		    if (ffesymbol_init (s) != NULL)
-		      initexpr = ffecom_expr (ffesymbol_init (s));
-		    else
-		      initexpr = ffecom_init_zero_ (t);
-		  }
-		else if (ffe_is_init_local_zero ())
-		  initexpr = ffecom_init_zero_ (t);
-		else
-		  initexpr = NULL_TREE;	/* Not ref'd if !init. */
-
-		finish_decl (t, initexpr, FALSE);
-
-		if (st != NULL && DECL_SIZE (t) != error_mark_node)
-		  {
-		    assert (TREE_CODE (DECL_SIZE_UNIT (t)) == INTEGER_CST);
-		    assert (0 == compare_tree_int (DECL_SIZE_UNIT (t),
-						   ffestorag_size (st)));
-		  }
-	      }
-	  }
-	  break;
-
-	case FFEINFO_whereRESULT:
-	  assert (!ffecom_transform_only_dummies_);
-
-	  if (bt == FFEINFO_basictypeCHARACTER)
-	    {			/* Result is already in list of dummies, use
-				   it (& length). */
-	      t = ffecom_func_result_;
-	      tlen = ffecom_func_length_;
-	      addr = TRUE;
-	      break;
-	    }
-	  if ((ffecom_num_entrypoints_ == 0)
-	      && (bt == FFEINFO_basictypeCOMPLEX)
-	      && (ffesymbol_is_f2c (ffecom_primary_entry_)))
-	    {			/* Result is already in list of dummies, use
-				   it. */
-	      t = ffecom_func_result_;
-	      addr = TRUE;
-	      break;
-	    }
-	  if (ffecom_func_result_ != NULL_TREE)
-	    {
-	      t = ffecom_func_result_;
-	      break;
-	    }
-	  if ((ffecom_num_entrypoints_ != 0)
-	      && (ffecom_master_bt_ == FFEINFO_basictypeNONE))
-	    {
-	      assert (ffecom_multi_retval_ != NULL_TREE);
-	      t = ffecom_1 (INDIRECT_REF, ffecom_multi_type_node_,
-			    ffecom_multi_retval_);
-	      t = ffecom_2 (COMPONENT_REF, ffecom_tree_type[bt][kt],
-			    t, ffecom_multi_fields_[bt][kt]);
-
-	      break;
-	    }
-
-	  t = build_decl (VAR_DECL,
-			  ffecom_get_identifier_ (ffesymbol_text (s)),
-			  ffecom_tree_type[bt][kt]);
-	  TREE_STATIC (t) = 0;	/* Put result on stack. */
-	  t = start_decl (t, FALSE);
-	  finish_decl (t, NULL_TREE, FALSE);
-
-	  ffecom_func_result_ = t;
-
-	  break;
-
-	case FFEINFO_whereDUMMY:
-	  {
-	    tree type;
-	    ffebld dl;
-	    ffebld dim;
-	    tree low;
-	    tree high;
-	    tree old_sizes;
-	    bool adjustable = FALSE;	/* Conditionally adjustable? */
-
-	    type = ffecom_tree_type[bt][kt];
-	    if (ffesymbol_sfdummyparent (s) != NULL)
-	      {
-		if (current_function_decl == ffecom_outer_function_decl_)
-		  {			/* Exec transition before sfunc
-					   context; get it later. */
-		    break;
-		  }
-		t = ffecom_get_identifier_ (ffesymbol_text
-					    (ffesymbol_sfdummyparent (s)));
-	      }
-	    else
-	      t = ffecom_get_identifier_ (ffesymbol_text (s));
-
-	    assert (ffecom_transform_only_dummies_);
-
-	    old_sizes = get_pending_sizes ();
-	    put_pending_sizes (old_sizes);
-
-	    if (bt == FFEINFO_basictypeCHARACTER)
-	      tlen = ffecom_char_enhance_arg_ (&type, s);
-	    type = ffecom_check_size_overflow_ (s, type, TRUE);
-
-	    for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl))
-	      {
-		if (type == error_mark_node)
-		  break;
-
-		dim = ffebld_head (dl);
-		assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
-		if ((ffebld_left (dim) == NULL) || ffecom_doing_entry_)
-		  low = ffecom_integer_one_node;
-		else
-		  low = ffecom_expr (ffebld_left (dim));
-		assert (ffebld_right (dim) != NULL);
-		if ((ffebld_op (ffebld_right (dim)) == FFEBLD_opSTAR)
-		    || ffecom_doing_entry_)
-		  {
-		    /* Used to just do high=low.  But for ffecom_tree_
-		       canonize_ref_, it probably is important to correctly
-		       assess the size.  E.g. given COMPLEX C(*),CFUNC and
-		       C(2)=CFUNC(C), overlap can happen, while it can't
-		       for, say, C(1)=CFUNC(C(2)).  */
-		    /* Even more recently used to set to INT_MAX, but that
-		       broke when some overflow checking went into the back
-		       end.  Now we just leave the upper bound unspecified.  */
-		    high = NULL;
-		  }
-		else
-		  high = ffecom_expr (ffebld_right (dim));
-
-		/* Determine whether array is conditionally adjustable,
-		   to decide whether back-end magic is needed.
-
-		   Normally the front end uses the back-end function
-		   variable_size to wrap SAVE_EXPR's around expressions
-		   affecting the size/shape of an array so that the
-		   size/shape info doesn't change during execution
-		   of the compiled code even though variables and
-		   functions referenced in those expressions might.
-
-		   variable_size also makes sure those saved expressions
-		   get evaluated immediately upon entry to the
-		   compiled procedure -- the front end normally doesn't
-		   have to worry about that.
-
-		   However, there is a problem with this that affects
-		   g77's implementation of entry points, and that is
-		   that it is _not_ true that each invocation of the
-		   compiled procedure is permitted to evaluate
-		   array size/shape info -- because it is possible
-		   that, for some invocations, that info is invalid (in
-		   which case it is "promised" -- i.e. a violation of
-		   the Fortran standard -- that the compiled code
-		   won't reference the array or its size/shape
-		   during that particular invocation).
-
-		   To phrase this in C terms, consider this gcc function:
-
-		     void foo (int *n, float (*a)[*n])
-		     {
-		       // a is "pointer to array ...", fyi.
-		     }
-
-		   Suppose that, for some invocations, it is permitted
-		   for a caller of foo to do this:
-
-		       foo (NULL, NULL);
-
-		   Now the _written_ code for foo can take such a call
-		   into account by either testing explicitly for whether
-		   (a == NULL) || (n == NULL) -- presumably it is
-		   not permitted to reference *a in various fashions
-		   if (n == NULL) I suppose -- or it can avoid it by
-		   looking at other info (other arguments, static/global
-		   data, etc.).
-
-		   However, this won't work in gcc 2.5.8 because it'll
-		   automatically emit the code to save the "*n"
-		   expression, which'll yield a NULL dereference for
-		   the "foo (NULL, NULL)" call, something the code
-		   for foo cannot prevent.
-
-		   g77 definitely needs to avoid executing such
-		   code anytime the pointer to the adjustable array
-		   is NULL, because even if its bounds expressions
-		   don't have any references to possible "absent"
-		   variables like "*n" -- say all variable references
-		   are to COMMON variables, i.e. global (though in C,
-		   local static could actually make sense) -- the
-		   expressions could yield other run-time problems
-		   for allowably "dead" values in those variables.
-
-		   For example, let's consider a more complicated
-		   version of foo:
-
-		     extern int i;
-		     extern int j;
-
-		     void foo (float (*a)[i/j])
-		     {
-		       ...
-		     }
-
-		   The above is (essentially) quite valid for Fortran
-		   but, again, for a call like "foo (NULL);", it is
-		   permitted for i and j to be undefined when the
-		   call is made.  If j happened to be zero, for
-		   example, emitting the code to evaluate "i/j"
-		   could result in a run-time error.
-
-		   Offhand, though I don't have my F77 or F90
-		   standards handy, it might even be valid for a
-		   bounds expression to contain a function reference,
-		   in which case I doubt it is permitted for an
-		   implementation to invoke that function in the
-		   Fortran case involved here (invocation of an
-		   alternate ENTRY point that doesn't have the adjustable
-		   array as one of its arguments).
-
-		   So, the code that the compiler would normally emit
-		   to preevaluate the size/shape info for an
-		   adjustable array _must not_ be executed at run time
-		   in certain cases.  Specifically, for Fortran,
-		   the case is when the pointer to the adjustable
-		   array == NULL.  (For gnu-ish C, it might be nice
-		   for the source code itself to specify an expression
-		   that, if TRUE, inhibits execution of the code.  Or
-		   reverse the sense for elegance.)
-
-		   (Note that g77 could use a different test than NULL,
-		   actually, since it happens to always pass an
-		   integer to the called function that specifies which
-		   entry point is being invoked.  Hmm, this might
-		   solve the next problem.)
-
-		   One way a user could, I suppose, write "foo" so
-		   it works is to insert COND_EXPR's for the
-		   size/shape info so the dangerous stuff isn't
-		   actually done, as in:
-
-		     void foo (int *n, float (*a)[(a == NULL) ? 0 : *n])
-		     {
-		       ...
-		     }
-
-		   The next problem is that the front end needs to
-		   be able to tell the back end about the array's
-		   decl _before_ it tells it about the conditional
-		   expression to inhibit evaluation of size/shape info,
-		   as shown above.
-
-		   To solve this, the front end needs to be able
-		   to give the back end the expression to inhibit
-		   generation of the preevaluation code _after_
-		   it makes the decl for the adjustable array.
-
-		   Until then, the above example using the COND_EXPR
-		   doesn't pass muster with gcc because the "(a == NULL)"
-		   part has a reference to "a", which is still
-		   undefined at that point.
-
-		   g77 will therefore use a different mechanism in the
-		   meantime.  */
-
-		if (!adjustable
-		    && ((TREE_CODE (low) != INTEGER_CST)
-			|| (high && TREE_CODE (high) != INTEGER_CST)))
-		  adjustable = TRUE;
-
-#if 0				/* Old approach -- see below. */
-		if (TREE_CODE (low) != INTEGER_CST)
-		  low = ffecom_3 (COND_EXPR, integer_type_node,
-				  ffecom_adjarray_passed_ (s),
-				  low,
-				  ffecom_integer_zero_node);
-
-		if (high && TREE_CODE (high) != INTEGER_CST)
-		  high = ffecom_3 (COND_EXPR, integer_type_node,
-				   ffecom_adjarray_passed_ (s),
-				   high,
-				   ffecom_integer_zero_node);
-#endif
-
-		/* ~~~gcc/stor-layout.c (layout_type) should do this,
-		   probably.  Fixes 950302-1.f.  */
-
-		if (TREE_CODE (low) != INTEGER_CST)
-		  low = variable_size (low);
-
-		/* ~~~Similarly, this fixes dumb0.f.  The C front end
-		   does this, which is why dumb0.c would work.  */
-
-		if (high && TREE_CODE (high) != INTEGER_CST)
-		  high = variable_size (high);
-
-		type
-		  = build_array_type
-		    (type,
-		     build_range_type (ffecom_integer_type_node,
-				       low, high));
-		type = ffecom_check_size_overflow_ (s, type, TRUE);
-	      }
-
-	    if (type == error_mark_node)
-	      {
-		t = error_mark_node;
-		break;
-	      }
-
-	    if ((ffesymbol_sfdummyparent (s) == NULL)
-		 || (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER))
-	      {
-		type = build_pointer_type (type);
-		addr = TRUE;
-	      }
-
-	    t = build_decl (PARM_DECL, t, type);
-	    DECL_ARTIFICIAL (t) = 1;
-
-	    /* If this arg is present in every entry point's list of
-	       dummy args, then we're done.  */
-
-	    if (ffesymbol_numentries (s)
-		== (ffecom_num_entrypoints_ + 1))
-	      break;
-
-#if 1
-
-	    /* If variable_size in stor-layout has been called during
-	       the above, then get_pending_sizes should have the
-	       yet-to-be-evaluated saved expressions pending.
-	       Make the whole lot of them get emitted, conditionally
-	       on whether the array decl ("t" above) is not NULL.  */
-
-	    {
-	      tree sizes = get_pending_sizes ();
-	      tree tem;
-
-	      for (tem = sizes;
-		   tem != old_sizes;
-		   tem = TREE_CHAIN (tem))
-		{
-		  tree temv = TREE_VALUE (tem);
-
-		  if (sizes == tem)
-		    sizes = temv;
-		  else
-		    sizes
-		      = ffecom_2 (COMPOUND_EXPR,
-				  TREE_TYPE (sizes),
-				  temv,
-				  sizes);
-		}
-
-	      if (sizes != tem)
-		{
-		  sizes
-		    = ffecom_3 (COND_EXPR,
-				TREE_TYPE (sizes),
-				ffecom_2 (NE_EXPR,
-					  integer_type_node,
-					  t,
-					  null_pointer_node),
-				sizes,
-				convert (TREE_TYPE (sizes),
-					 integer_zero_node));
-		  sizes = ffecom_save_tree (sizes);
-
-		  sizes
-		    = tree_cons (NULL_TREE, sizes, tem);
-		}
-
-	      if (sizes)
-		put_pending_sizes (sizes);
-	    }
-
-#else
-#if 0
-	    if (adjustable
-		&& (ffesymbol_numentries (s)
-		    != ffecom_num_entrypoints_ + 1))
-	      DECL_SOMETHING (t)
-		= ffecom_2 (NE_EXPR, integer_type_node,
-			    t,
-			    null_pointer_node);
-#else
-#if 0
-	    if (adjustable
-		&& (ffesymbol_numentries (s)
-		    != ffecom_num_entrypoints_ + 1))
-	      {
-		ffebad_start (FFEBAD_MISSING_ADJARRAY_UNSUPPORTED);
-		ffebad_here (0, ffesymbol_where_line (s),
-			     ffesymbol_where_column (s));
-		ffebad_string (ffesymbol_text (s));
-		ffebad_finish ();
-	      }
-#endif
-#endif
-#endif
-	  }
-	  break;
-
-	case FFEINFO_whereCOMMON:
-	  {
-	    ffesymbol cs;
-	    ffeglobal cg;
-	    tree ct;
-	    ffestorag st = ffesymbol_storage (s);
-	    tree type;
-
-	    cs = ffesymbol_common (s);	/* The COMMON area itself.  */
-	    if (st != NULL)	/* Else not laid out. */
-	      {
-		ffecom_transform_common_ (cs);
-		st = ffesymbol_storage (s);
-	      }
-
-	    type = ffecom_type_localvar_ (s, bt, kt);
-
-	    cg = ffesymbol_global (cs);	/* The global COMMON info.  */
-	    if ((cg == NULL)
-		|| (ffeglobal_type (cg) != FFEGLOBAL_typeCOMMON))
-	      ct = NULL_TREE;
-	    else
-	      ct = ffeglobal_hook (cg);	/* The common area's tree.  */
-
-	    if ((ct == NULL_TREE)
-		|| (st == NULL)
-		|| (type == error_mark_node))
-	      t = error_mark_node;
-	    else
-	      {
-		ffetargetOffset offset;
-		ffestorag cst;
-		tree toffset;
-
-		cst = ffestorag_parent (st);
-		assert (cst == ffesymbol_storage (cs));
-
-		offset = ffestorag_modulo (cst)
-		  + ffestorag_offset (st)
-		  - ffestorag_offset (cst);
-
-		ffecom_debug_kludge_ (ct, "COMMON", s, type, offset);
-
-		/* (t_type *) (((char *) &ct) + offset) */
-
-		t = convert (string_type_node,	/* (char *) */
-			     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, toffset);
-		t = convert (build_pointer_type (type),
-			     t);
-		TREE_CONSTANT (t) = 1;
-
-		addr = TRUE;
-	      }
-	  }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereGLOBAL:
-	case FFEINFO_whereFLEETING:
-	case FFEINFO_whereFLEETING_CADDR:
-	case FFEINFO_whereFLEETING_IADDR:
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereCONSTANT_SUBOBJECT:
-	default:
-	  assert ("ENTITY where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindFUNCTION:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:	/* Me. */
-	  assert (!ffecom_transform_only_dummies_);
-	  t = current_function_decl;
-	  break;
-
-	case FFEINFO_whereGLOBAL:
-	  assert (!ffecom_transform_only_dummies_);
-
-	  if (((g = ffesymbol_global (s)) != NULL)
-	      && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
-	      && (ffeglobal_hook (g) != NULL_TREE)
-	      && ffe_is_globals ())
-	    {
-	      t = ffeglobal_hook (g);
-	      break;
-	    }
-
-	  if (ffesymbol_is_f2c (s)
-	      && (ffesymbol_where (s) != FFEINFO_whereCONSTANT))
-	    t = ffecom_tree_fun_type[bt][kt];
-	  else
-	    t = build_function_type (ffecom_tree_type[bt][kt], NULL_TREE);
-
-	  t = build_decl (FUNCTION_DECL,
-			  ffecom_get_external_identifier_ (s),
-			  t);
-	  DECL_EXTERNAL (t) = 1;
-	  TREE_PUBLIC (t) = 1;
-
-	  t = start_decl (t, FALSE);
-	  finish_decl (t, NULL_TREE, FALSE);
-
-	  if ((g != NULL)
-	      && ((ffeglobal_type (g) == FFEGLOBAL_typeFUNC)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
-	    ffeglobal_set_hook (g, t);
-
-	  ffecom_save_tree_forever (t);
-
-	  break;
-
-	case FFEINFO_whereDUMMY:
-	  assert (ffecom_transform_only_dummies_);
-
-	  if (ffesymbol_is_f2c (s)
-	      && (ffesymbol_where (s) != FFEINFO_whereCONSTANT))
-	    t = ffecom_tree_ptr_to_fun_type[bt][kt];
-	  else
-	    t = build_pointer_type
-	      (build_function_type (ffecom_tree_type[bt][kt], NULL_TREE));
-
-	  t = build_decl (PARM_DECL,
-			  ffecom_get_identifier_ (ffesymbol_text (s)),
-			  t);
-	  DECL_ARTIFICIAL (t) = 1;
-	  addr = TRUE;
-	  break;
-
-	case FFEINFO_whereCONSTANT:	/* Statement function. */
-	  assert (!ffecom_transform_only_dummies_);
-	  t = ffecom_gen_sfuncdef_ (s, bt, kt);
-	  break;
-
-	case FFEINFO_whereINTRINSIC:
-	  assert (!ffecom_transform_only_dummies_);
-	  break;		/* Let actual references generate their
-				   decls. */
-
-	default:
-	  assert ("FUNCTION where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindSUBROUTINE:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:	/* Me. */
-	  assert (!ffecom_transform_only_dummies_);
-	  t = current_function_decl;
-	  break;
-
-	case FFEINFO_whereGLOBAL:
-	  assert (!ffecom_transform_only_dummies_);
-
-	  if (((g = ffesymbol_global (s)) != NULL)
-	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT))
-	      && (ffeglobal_hook (g) != NULL_TREE)
-	      && ffe_is_globals ())
-	    {
-	      t = ffeglobal_hook (g);
-	      break;
-	    }
-
-	  t = build_decl (FUNCTION_DECL,
-			  ffecom_get_external_identifier_ (s),
-			  ffecom_tree_subr_type);
-	  DECL_EXTERNAL (t) = 1;
-	  TREE_PUBLIC (t) = 1;
-
-	  t = start_decl (t, ffe_is_globals ());
-	  finish_decl (t, NULL_TREE, ffe_is_globals ());
-
-	  if ((g != NULL)
-	      && ((ffeglobal_type (g) == FFEGLOBAL_typeSUBR)
-		  || (ffeglobal_type (g) == FFEGLOBAL_typeEXT)))
-	    ffeglobal_set_hook (g, t);
-
-	  ffecom_save_tree_forever (t);
-
-	  break;
-
-	case FFEINFO_whereDUMMY:
-	  assert (ffecom_transform_only_dummies_);
-
-	  t = build_decl (PARM_DECL,
-			  ffecom_get_identifier_ (ffesymbol_text (s)),
-			  ffecom_tree_ptr_to_subr_type);
-	  DECL_ARTIFICIAL (t) = 1;
-	  addr = TRUE;
-	  break;
-
-	case FFEINFO_whereINTRINSIC:
-	  assert (!ffecom_transform_only_dummies_);
-	  break;		/* Let actual references generate their
-				   decls. */
-
-	default:
-	  assert ("SUBROUTINE where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindPROGRAM:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:	/* Me. */
-	  assert (!ffecom_transform_only_dummies_);
-	  t = current_function_decl;
-	  break;
-
-	case FFEINFO_whereCOMMON:
-	case FFEINFO_whereDUMMY:
-	case FFEINFO_whereGLOBAL:
-	case FFEINFO_whereRESULT:
-	case FFEINFO_whereFLEETING:
-	case FFEINFO_whereFLEETING_CADDR:
-	case FFEINFO_whereFLEETING_IADDR:
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereCONSTANT_SUBOBJECT:
-	default:
-	  assert ("PROGRAM where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindBLOCKDATA:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:	/* Me. */
-	  assert (!ffecom_transform_only_dummies_);
-	  t = current_function_decl;
-	  break;
-
-	case FFEINFO_whereGLOBAL:
-	  assert (!ffecom_transform_only_dummies_);
-
-	  t = build_decl (FUNCTION_DECL,
-			  ffecom_get_external_identifier_ (s),
-			  ffecom_tree_blockdata_type);
-	  DECL_EXTERNAL (t) = 1;
-	  TREE_PUBLIC (t) = 1;
-
-	  t = start_decl (t, FALSE);
-	  finish_decl (t, NULL_TREE, FALSE);
-
-	  ffecom_save_tree_forever (t);
-
-	  break;
-
-	case FFEINFO_whereCOMMON:
-	case FFEINFO_whereDUMMY:
-	case FFEINFO_whereRESULT:
-	case FFEINFO_whereFLEETING:
-	case FFEINFO_whereFLEETING_CADDR:
-	case FFEINFO_whereFLEETING_IADDR:
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereCONSTANT_SUBOBJECT:
-	default:
-	  assert ("BLOCKDATA where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindCOMMON:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:
-	  assert (!ffecom_transform_only_dummies_);
-	  ffecom_transform_common_ (s);
-	  break;
-
-	case FFEINFO_whereNONE:
-	case FFEINFO_whereCOMMON:
-	case FFEINFO_whereDUMMY:
-	case FFEINFO_whereGLOBAL:
-	case FFEINFO_whereRESULT:
-	case FFEINFO_whereFLEETING:
-	case FFEINFO_whereFLEETING_CADDR:
-	case FFEINFO_whereFLEETING_IADDR:
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereCONSTANT_SUBOBJECT:
-	default:
-	  assert ("COMMON where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindCONSTRUCT:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:
-	  assert (!ffecom_transform_only_dummies_);
-	  break;
-
-	case FFEINFO_whereNONE:
-	case FFEINFO_whereCOMMON:
-	case FFEINFO_whereDUMMY:
-	case FFEINFO_whereGLOBAL:
-	case FFEINFO_whereRESULT:
-	case FFEINFO_whereFLEETING:
-	case FFEINFO_whereFLEETING_CADDR:
-	case FFEINFO_whereFLEETING_IADDR:
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereCONSTANT_SUBOBJECT:
-	default:
-	  assert ("CONSTRUCT where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    case FFEINFO_kindNAMELIST:
-      switch (ffeinfo_where (ffesymbol_info (s)))
-	{
-	case FFEINFO_whereLOCAL:
-	  assert (!ffecom_transform_only_dummies_);
-	  t = ffecom_transform_namelist_ (s);
-	  break;
-
-	case FFEINFO_whereNONE:
-	case FFEINFO_whereCOMMON:
-	case FFEINFO_whereDUMMY:
-	case FFEINFO_whereGLOBAL:
-	case FFEINFO_whereRESULT:
-	case FFEINFO_whereFLEETING:
-	case FFEINFO_whereFLEETING_CADDR:
-	case FFEINFO_whereFLEETING_IADDR:
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereCONSTANT_SUBOBJECT:
-	default:
-	  assert ("NAMELIST where unheard of" == NULL);
-	  /* Fall through. */
-	case FFEINFO_whereANY:
-	  t = error_mark_node;
-	  break;
-	}
-      break;
-
-    default:
-      assert ("kind unheard of" == NULL);
-      /* Fall through. */
-    case FFEINFO_kindANY:
-      t = error_mark_node;
-      break;
-    }
-
-  ffesymbol_hook (s).decl_tree = t;
-  ffesymbol_hook (s).length_tree = tlen;
-  ffesymbol_hook (s).addr = addr;
-
-  input_location = old_loc;
-
-  return s;
-}
-
-/* Transform into ASSIGNable symbol.
-
-   Symbol has already been transformed, but for whatever reason, the
-   resulting decl_tree has been deemed not usable for an ASSIGN target.
-   (E.g. it isn't wide enough to hold a pointer.)  So, here we invent
-   another local symbol of type void * and stuff that in the assign_tree
-   argument.  The F77/F90 standards allow this implementation.  */
-
-static ffesymbol
-ffecom_sym_transform_assign_ (ffesymbol s)
-{
-  tree t;			/* Transformed thingy. */
-  location_t old_loc = input_location;
-
-  if (ffesymbol_sfdummyparent (s) == NULL)
-    {
-      input_filename = ffesymbol_where_filename (s);
-      input_line = ffesymbol_where_filelinenum (s);
-    }
-  else
-    {
-      ffesymbol sf = ffesymbol_sfdummyparent (s);
-
-      input_filename = ffesymbol_where_filename (sf);
-      input_line = ffesymbol_where_filelinenum (sf);
-    }
-
-  assert (!ffecom_transform_only_dummies_);
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_ASSIGN_%s",
-						   ffesymbol_text (s)),
-		  TREE_TYPE (null_pointer_node));
-
-  switch (ffesymbol_where (s))
-    {
-    case FFEINFO_whereLOCAL:
-      /* Unlike for regular vars, SAVE status is easy to determine for
-	 ASSIGNed vars, since there's no initialization, there's no
-	 effective storage association (so "SAVE J" does not apply to
-	 K even given "EQUIVALENCE (J,K)"), there's no size issue
-	 to worry about, etc.  */
-      if ((ffesymbol_is_save (s) || ffe_is_saveall ())
-	  && (ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
-	  && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA))
-	TREE_STATIC (t) = 1;	/* SAVEd in proc, make static. */
-      else
-	TREE_STATIC (t) = 0;	/* No need to make static. */
-      break;
-
-    case FFEINFO_whereCOMMON:
-      TREE_STATIC (t) = 1;	/* Assume COMMONs always SAVEd. */
-      break;
-
-    case FFEINFO_whereDUMMY:
-      /* Note that twinning a DUMMY means the caller won't see
-	 the ASSIGNed value.  But both F77 and F90 allow implementations
-	 to do this, i.e. disallow Fortran code that would try and
-	 take advantage of actually putting a label into a variable
-	 via a dummy argument (or any other storage association, for
-	 that matter).  */
-      TREE_STATIC (t) = 0;
-      break;
-
-    default:
-      TREE_STATIC (t) = 0;
-      break;
-    }
-
-  t = start_decl (t, FALSE);
-  finish_decl (t, NULL_TREE, FALSE);
-
-  ffesymbol_hook (s).assign_tree = t;
-
-  input_location = old_loc;
-
-  return s;
-}
-
-/* Implement COMMON area in back end.
-
-   Because COMMON-based variables can be referenced in the dimension
-   expressions of dummy (adjustable) arrays, and because dummies
-   (in the gcc back end) need to be put in the outer binding level
-   of a function (which has two binding levels, the outer holding
-   the dummies and the inner holding the other vars), special care
-   must be taken to handle COMMON areas.
-
-   The current strategy is basically to always tell the back end about
-   the COMMON area as a top-level external reference to just a block
-   of storage of the master type of that area (e.g. integer, real,
-   character, whatever -- not a structure).  As a distinct action,
-   if initial values are provided, tell the back end about the area
-   as a top-level non-external (initialized) area and remember not to
-   allow further initialization or expansion of the area.  Meanwhile,
-   if no initialization happens at all, tell the back end about
-   the largest size we've seen declared so the space does get reserved.
-   (This function doesn't handle all that stuff, but it does some
-   of the important things.)
-
-   Meanwhile, for COMMON variables themselves, just keep creating
-   references like *((float *) (&common_area + offset)) each time
-   we reference the variable.  In other words, don't make a VAR_DECL
-   or any kind of component reference (like we used to do before 0.4),
-   though we might do that as well just for debugging purposes (and
-   stuff the rtl with the appropriate offset expression).  */
-
-static void
-ffecom_transform_common_ (ffesymbol s)
-{
-  ffestorag st = ffesymbol_storage (s);
-  ffeglobal g = ffesymbol_global (s);
-  tree cbt;
-  tree cbtype;
-  tree init;
-  tree high;
-  bool is_init = ffestorag_is_init (st);
-
-  assert (st != NULL);
-
-  if ((g == NULL)
-      || (ffeglobal_type (g) != FFEGLOBAL_typeCOMMON))
-    return;
-
-  /* First update the size of the area in global terms.  */
-
-  ffeglobal_size_common (s, ffestorag_size (st));
-
-  if (!ffeglobal_common_init (g))
-    is_init = FALSE;	/* No explicit init, don't let erroneous joins init. */
-
-  cbt = ffeglobal_hook (g);
-
-  /* If we already have declared this common block for a previous program
-     unit, and either we already initialized it or we don't have new
-     initialization for it, just return what we have without changing it.  */
-
-  if ((cbt != NULL_TREE)
-      && (!is_init
-	  || !DECL_EXTERNAL (cbt)))
-    {
-      if (st->hook == NULL) ffestorag_set_hook (st, cbt);
-      return;
-    }
-
-  /* Process inits.  */
-
-  if (is_init)
-    {
-      if (ffestorag_init (st) != NULL)
-	{
-	  ffebld sexp;
-
-	  /* Set the padding for the expression, so ffecom_expr
-	     knows to insert that many zeros.  */
-	  switch (ffebld_op (sexp = ffestorag_init (st)))
-	    {
-	    case FFEBLD_opCONTER:
-	      ffebld_conter_set_pad (sexp, ffestorag_modulo (st));
-	      break;
-
-	    case FFEBLD_opARRTER:
-	      ffebld_arrter_set_pad (sexp, ffestorag_modulo (st));
-	      break;
-
-	    case FFEBLD_opACCTER:
-	      ffebld_accter_set_pad (sexp, ffestorag_modulo (st));
-	      break;
-
-	    default:
-	      assert ("bad op for cmn init (pad)" == NULL);
-	      break;
-	    }
-
-	  init = ffecom_expr (sexp);
-	  if (init == error_mark_node)
-	    {			/* Hopefully the back end complained! */
-	      init = NULL_TREE;
-	      if (cbt != NULL_TREE)
-		return;
-	    }
-	}
-      else
-	init = error_mark_node;
-    }
-  else
-    init = NULL_TREE;
-
-  /* cbtype must be permanently allocated!  */
-
-  /* Allocate the MAX of the areas so far, seen filewide.  */
-  high = build_int_2 ((ffeglobal_common_size (g)
-		       + ffeglobal_common_pad (g)) - 1, 0);
-  TREE_TYPE (high) = ffecom_integer_type_node;
-
-  if (init)
-    cbtype = build_array_type (char_type_node,
-			       build_range_type (integer_type_node,
-						 integer_zero_node,
-						 high));
-  else
-    cbtype = build_array_type (char_type_node, NULL_TREE);
-
-  if (cbt == NULL_TREE)
-    {
-      cbt
-	= build_decl (VAR_DECL,
-		      ffecom_get_external_identifier_ (s),
-		      cbtype);
-      TREE_STATIC (cbt) = 1;
-      TREE_PUBLIC (cbt) = 1;
-    }
-  else
-    {
-      assert (is_init);
-      TREE_TYPE (cbt) = cbtype;
-    }
-  DECL_EXTERNAL (cbt) = init ? 0 : 1;
-  DECL_INITIAL (cbt) = init ? error_mark_node : NULL_TREE;
-
-  cbt = start_decl (cbt, TRUE);
-  if (ffeglobal_hook (g) != NULL)
-    assert (cbt == ffeglobal_hook (g));
-
-  assert (!init || !DECL_EXTERNAL (cbt));
-
-  /* Make sure that any type can live in COMMON and be referenced
-     without getting a bus error.  We could pick the most restrictive
-     alignment of all entities actually placed in the COMMON, but
-     this seems easy enough.  */
-
-  DECL_ALIGN (cbt) = BIGGEST_ALIGNMENT;
-  DECL_USER_ALIGN (cbt) = 0;
-
-  if (is_init && (ffestorag_init (st) == NULL))
-    init = ffecom_init_zero_ (cbt);
-
-  finish_decl (cbt, init, TRUE);
-
-  if (is_init)
-    ffestorag_set_init (st, ffebld_new_any ());
-
-  if (init)
-    {
-      assert (DECL_SIZE_UNIT (cbt) != NULL_TREE);
-      assert (TREE_CODE (DECL_SIZE_UNIT (cbt)) == INTEGER_CST);
-      assert (0 == compare_tree_int (DECL_SIZE_UNIT (cbt),
-				     (ffeglobal_common_size (g)
-				      + ffeglobal_common_pad (g))));
-    }
-
-  ffeglobal_set_hook (g, cbt);
-
-  ffestorag_set_hook (st, cbt);
-
-  ffecom_save_tree_forever (cbt);
-}
-
-/* Make master area for local EQUIVALENCE.  */
-
-static void
-ffecom_transform_equiv_ (ffestorag eqst)
-{
-  tree eqt;
-  tree eqtype;
-  tree init;
-  tree high;
-  bool is_init = ffestorag_is_init (eqst);
-
-  assert (eqst != NULL);
-
-  eqt = ffestorag_hook (eqst);
-
-  if (eqt != NULL_TREE)
-    return;
-
-  /* Process inits.  */
-
-  if (is_init)
-    {
-      if (ffestorag_init (eqst) != NULL)
-	{
-	  ffebld sexp;
-
-	  /* Set the padding for the expression, so ffecom_expr
-	     knows to insert that many zeros.  */
-	  switch (ffebld_op (sexp = ffestorag_init (eqst)))
-	    {
-	    case FFEBLD_opCONTER:
-	      ffebld_conter_set_pad (sexp, ffestorag_modulo (eqst));
-	      break;
-
-	    case FFEBLD_opARRTER:
-	      ffebld_arrter_set_pad (sexp, ffestorag_modulo (eqst));
-	      break;
-
-	    case FFEBLD_opACCTER:
-	      ffebld_accter_set_pad (sexp, ffestorag_modulo (eqst));
-	      break;
-
-	    default:
-	      assert ("bad op for eqv init (pad)" == NULL);
-	      break;
-	    }
-
-	  init = ffecom_expr (sexp);
-	  if (init == error_mark_node)
-	    init = NULL_TREE;	/* Hopefully the back end complained! */
-	}
-      else
-	init = error_mark_node;
-    }
-  else if (ffe_is_init_local_zero ())
-    init = error_mark_node;
-  else
-    init = NULL_TREE;
-
-  ffecom_member_namelisted_ = FALSE;
-  ffestorag_drive (ffestorag_list_equivs (eqst),
-		   &ffecom_member_phase1_,
-		   eqst);
-
-  high = build_int_2 ((ffestorag_size (eqst)
-		       + ffestorag_modulo (eqst)) - 1, 0);
-  TREE_TYPE (high) = ffecom_integer_type_node;
-
-  eqtype = build_array_type (char_type_node,
-			     build_range_type (ffecom_integer_type_node,
-					       ffecom_integer_zero_node,
-					       high));
-
-  eqt = build_decl (VAR_DECL,
-		    ffecom_get_invented_identifier ("__g77_equiv_%s",
-						    ffesymbol_text
-						    (ffestorag_symbol (eqst))),
-		    eqtype);
-  DECL_EXTERNAL (eqt) = 0;
-  if (is_init
-      || ffecom_member_namelisted_
-#ifdef FFECOM_sizeMAXSTACKITEM
-      || (ffestorag_size (eqst) > FFECOM_sizeMAXSTACKITEM)
-#endif
-      || ((ffecom_primary_entry_kind_ != FFEINFO_kindPROGRAM)
-	  && (ffecom_primary_entry_kind_ != FFEINFO_kindBLOCKDATA)
-	  && (ffestorag_is_save (eqst) || ffe_is_saveall ())))
-    TREE_STATIC (eqt) = 1;
-  else
-    TREE_STATIC (eqt) = 0;
-  TREE_PUBLIC (eqt) = 0;
-  TREE_ADDRESSABLE (eqt) = 1;  /* Ensure non-register allocation */
-  DECL_CONTEXT (eqt) = current_function_decl;
-  if (init)
-    DECL_INITIAL (eqt) = error_mark_node;
-  else
-    DECL_INITIAL (eqt) = NULL_TREE;
-
-  eqt = start_decl (eqt, FALSE);
-
-  /* Make sure that any type can live in EQUIVALENCE and be referenced
-     without getting a bus error.  We could pick the most restrictive
-     alignment of all entities actually placed in the EQUIVALENCE, but
-     this seems easy enough.  */
-
-  DECL_ALIGN (eqt) = BIGGEST_ALIGNMENT;
-  DECL_USER_ALIGN (eqt) = 0;
-
-  if ((!is_init && ffe_is_init_local_zero ())
-      || (is_init && (ffestorag_init (eqst) == NULL)))
-    init = ffecom_init_zero_ (eqt);
-
-  finish_decl (eqt, init, FALSE);
-
-  if (is_init)
-    ffestorag_set_init (eqst, ffebld_new_any ());
-
-  {
-    assert (TREE_CODE (DECL_SIZE_UNIT (eqt)) == INTEGER_CST);
-    assert (0 == compare_tree_int (DECL_SIZE_UNIT (eqt),
-				   (ffestorag_size (eqst)
-				    + ffestorag_modulo (eqst))));
-  }
-
-  ffestorag_set_hook (eqst, eqt);
-
-  ffestorag_drive (ffestorag_list_equivs (eqst),
-		   &ffecom_member_phase2_,
-		   eqst);
-}
-
-/* Implement NAMELIST in back end.  See f2c/format.c for more info.  */
-
-static tree
-ffecom_transform_namelist_ (ffesymbol s)
-{
-  tree nmlt;
-  tree nmltype = ffecom_type_namelist_ ();
-  tree nmlinits;
-  tree nameinit;
-  tree varsinit;
-  tree nvarsinit;
-  tree field;
-  tree high;
-  int i;
-  static int mynumber = 0;
-
-  nmlt = build_decl (VAR_DECL,
-		     ffecom_get_invented_identifier ("__g77_namelist_%d",
-						     mynumber++),
-		     nmltype);
-  TREE_STATIC (nmlt) = 1;
-  DECL_INITIAL (nmlt) = error_mark_node;
-
-  nmlt = start_decl (nmlt, FALSE);
-
-  /* Process inits.  */
-
-  i = strlen (ffesymbol_text (s));
-
-  high = build_int_2 (i, 0);
-  TREE_TYPE (high) = ffecom_f2c_ftnlen_type_node;
-
-  nameinit = ffecom_build_f2c_string_ (i + 1,
-				       ffesymbol_text (s));
-  TREE_TYPE (nameinit)
-    = build_type_variant
-    (build_array_type
-     (char_type_node,
-      build_range_type (ffecom_f2c_ftnlen_type_node,
-			ffecom_f2c_ftnlen_one_node,
-			high)),
-     1, 0);
-  TREE_CONSTANT (nameinit) = 1;
-  TREE_STATIC (nameinit) = 1;
-  nameinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (nameinit)),
-		       nameinit);
-
-  varsinit = ffecom_vardesc_array_ (s);
-  varsinit = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (varsinit)),
-		       varsinit);
-  TREE_CONSTANT (varsinit) = 1;
-  TREE_STATIC (varsinit) = 1;
-
-  {
-    ffebld b;
-
-    for (i = 0, b = ffesymbol_namelist (s); b != NULL; b = ffebld_trail (b))
-      ++i;
-  }
-  nvarsinit = build_int_2 (i, 0);
-  TREE_TYPE (nvarsinit) = integer_type_node;
-  TREE_CONSTANT (nvarsinit) = 1;
-  TREE_STATIC (nvarsinit) = 1;
-
-  nmlinits = build_tree_list ((field = TYPE_FIELDS (nmltype)), nameinit);
-  TREE_CHAIN (nmlinits) = build_tree_list ((field = TREE_CHAIN (field)),
-					   varsinit);
-  TREE_CHAIN (TREE_CHAIN (nmlinits))
-    = build_tree_list ((field = TREE_CHAIN (field)), nvarsinit);
-
-  nmlinits = build_constructor (nmltype, nmlinits);
-  TREE_CONSTANT (nmlinits) = 1;
-  TREE_STATIC (nmlinits) = 1;
-
-  finish_decl (nmlt, nmlinits, FALSE);
-
-  nmlt = ffecom_1 (ADDR_EXPR, build_pointer_type (nmltype), nmlt);
-
-  return nmlt;
-}
-
-/* A subroutine of ffecom_tree_canonize_ref_.  The incoming tree is
-   analyzed on the assumption it is calculating a pointer to be
-   indirected through.  It must return the proper decl and offset,
-   taking into account different units of measurements for offsets.  */
-
-static void
-ffecom_tree_canonize_ptr_ (tree *decl, tree *offset, tree t)
-{
-  switch (TREE_CODE (t))
-    {
-    case NOP_EXPR:
-    case CONVERT_EXPR:
-    case NON_LVALUE_EXPR:
-      ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0));
-      break;
-
-    case PLUS_EXPR:
-      ffecom_tree_canonize_ptr_ (decl, offset, TREE_OPERAND (t, 0));
-      if ((*decl == NULL_TREE)
-	  || (*decl == error_mark_node))
-	break;
-
-      if (TREE_CODE (TREE_OPERAND (t, 1)) == INTEGER_CST)
-	{
-	  /* An offset into COMMON.  */
-	  *offset = fold (build (PLUS_EXPR, TREE_TYPE (*offset),
-				 *offset, TREE_OPERAND (t, 1)));
-	  /* Convert offset (presumably in bytes) into canonical units
-	     (presumably bits).  */
-	  *offset = size_binop (MULT_EXPR,
-				convert (bitsizetype, *offset),
-				TYPE_SIZE (TREE_TYPE (TREE_TYPE (t))));
-	  break;
-	}
-      /* Not a COMMON reference, so an unrecognized pattern.  */
-      *decl = error_mark_node;
-      break;
-
-    case PARM_DECL:
-      *decl = t;
-      *offset = bitsize_zero_node;
-      break;
-
-    case ADDR_EXPR:
-      if (TREE_CODE (TREE_OPERAND (t, 0)) == VAR_DECL)
-	{
-	  /* A reference to COMMON.  */
-	  *decl = TREE_OPERAND (t, 0);
-	  *offset = bitsize_zero_node;
-	  break;
-	}
-      /* Fall through.  */
-    default:
-      /* Not a COMMON reference, so an unrecognized pattern.  */
-      *decl = error_mark_node;
-      break;
-    }
-}
-
-/* Given a tree that is possibly intended for use as an lvalue, return
-   information representing a canonical view of that tree as a decl, an
-   offset into that decl, and a size for the lvalue.
-
-   If there's no applicable decl, NULL_TREE is returned for the decl,
-   and the other fields are left undefined.
-
-   If the tree doesn't fit the recognizable forms, an ERROR_MARK node
-   is returned for the decl, and the other fields are left undefined.
-
-   Otherwise, the decl returned currently is either a VAR_DECL or a
-   PARM_DECL.
-
-   The offset returned is always valid, but of course not necessarily
-   a constant, and not necessarily converted into the appropriate
-   type, leaving that up to the caller (so as to avoid that overhead
-   if the decls being looked at are different anyway).
-
-   If the size cannot be determined (e.g. an adjustable array),
-   an ERROR_MARK node is returned for the size.  Otherwise, the
-   size returned is valid, not necessarily a constant, and not
-   necessarily converted into the appropriate type as with the
-   offset.
-
-   Note that the offset and size expressions are expressed in the
-   base storage units (usually bits) rather than in the units of
-   the type of the decl, because two decls with different types
-   might overlap but with apparently non-overlapping array offsets,
-   whereas converting the array offsets to consistant offsets will
-   reveal the overlap.  */
-
-static void
-ffecom_tree_canonize_ref_ (tree *decl, tree *offset, tree *size, tree t)
-{
-  /* The default path is to report a nonexistant decl.  */
-  *decl = NULL_TREE;
-
-  if (t == NULL_TREE)
-    return;
-
-  switch (TREE_CODE (t))
-    {
-    case ERROR_MARK:
-    case IDENTIFIER_NODE:
-    case INTEGER_CST:
-    case REAL_CST:
-    case COMPLEX_CST:
-    case STRING_CST:
-    case CONST_DECL:
-    case PLUS_EXPR:
-    case MINUS_EXPR:
-    case MULT_EXPR:
-    case TRUNC_DIV_EXPR:
-    case CEIL_DIV_EXPR:
-    case FLOOR_DIV_EXPR:
-    case ROUND_DIV_EXPR:
-    case TRUNC_MOD_EXPR:
-    case CEIL_MOD_EXPR:
-    case FLOOR_MOD_EXPR:
-    case ROUND_MOD_EXPR:
-    case RDIV_EXPR:
-    case EXACT_DIV_EXPR:
-    case FIX_TRUNC_EXPR:
-    case FIX_CEIL_EXPR:
-    case FIX_FLOOR_EXPR:
-    case FIX_ROUND_EXPR:
-    case FLOAT_EXPR:
-    case NEGATE_EXPR:
-    case MIN_EXPR:
-    case MAX_EXPR:
-    case ABS_EXPR:
-    case LSHIFT_EXPR:
-    case RSHIFT_EXPR:
-    case LROTATE_EXPR:
-    case RROTATE_EXPR:
-    case BIT_IOR_EXPR:
-    case BIT_XOR_EXPR:
-    case BIT_AND_EXPR:
-    case BIT_NOT_EXPR:
-    case TRUTH_ANDIF_EXPR:
-    case TRUTH_ORIF_EXPR:
-    case TRUTH_AND_EXPR:
-    case TRUTH_OR_EXPR:
-    case TRUTH_XOR_EXPR:
-    case TRUTH_NOT_EXPR:
-    case LT_EXPR:
-    case LE_EXPR:
-    case GT_EXPR:
-    case GE_EXPR:
-    case EQ_EXPR:
-    case NE_EXPR:
-    case COMPLEX_EXPR:
-    case CONJ_EXPR:
-    case REALPART_EXPR:
-    case IMAGPART_EXPR:
-    case LABEL_EXPR:
-    case COMPONENT_REF:
-    case COMPOUND_EXPR:
-    case ADDR_EXPR:
-      return;
-
-    case VAR_DECL:
-    case PARM_DECL:
-      *decl = t;
-      *offset = bitsize_zero_node;
-      *size = TYPE_SIZE (TREE_TYPE (t));
-      return;
-
-    case ARRAY_REF:
-      {
-	tree array = TREE_OPERAND (t, 0);
-	tree element = TREE_OPERAND (t, 1);
-	tree init_offset;
-
-	if ((array == NULL_TREE)
-	    || (element == NULL_TREE))
-	  {
-	    *decl = error_mark_node;
-	    return;
-	  }
-
-	ffecom_tree_canonize_ref_ (decl, &init_offset, size,
-				   array);
-	if ((*decl == NULL_TREE)
-	    || (*decl == error_mark_node))
-	  return;
-
-	/* Calculate ((element - base) * NBBY) + init_offset.  */
-	*offset = fold (build (MINUS_EXPR, TREE_TYPE (element),
-			       element,
-			       TYPE_MIN_VALUE (TYPE_DOMAIN
-					       (TREE_TYPE (array)))));
-
-	*offset = size_binop (MULT_EXPR,
-			      convert (bitsizetype, *offset),
-			      TYPE_SIZE (TREE_TYPE (TREE_TYPE (array))));
-
-	*offset = size_binop (PLUS_EXPR, init_offset, *offset);
-
-	*size = TYPE_SIZE (TREE_TYPE (t));
-	return;
-      }
-
-    case INDIRECT_REF:
-
-      /* Most of this code is to handle references to COMMON.  And so
-	 far that is useful only for calling library functions, since
-	 external (user) functions might reference common areas.  But
-	 even calling an external function, it's worthwhile to decode
-	 COMMON references because if not storing into COMMON, we don't
-	 want COMMON-based arguments to gratuitously force use of a
-	 temporary.  */
-
-      *size = TYPE_SIZE (TREE_TYPE (t));
-
-      ffecom_tree_canonize_ptr_ (decl, offset,
-				 TREE_OPERAND (t, 0));
-
-      return;
-
-    case CONVERT_EXPR:
-    case NOP_EXPR:
-    case MODIFY_EXPR:
-    case NON_LVALUE_EXPR:
-    case RESULT_DECL:
-    case FIELD_DECL:
-    case COND_EXPR:		/* More cases than we can handle. */
-    case SAVE_EXPR:
-    case REFERENCE_EXPR:
-    case PREDECREMENT_EXPR:
-    case PREINCREMENT_EXPR:
-    case POSTDECREMENT_EXPR:
-    case POSTINCREMENT_EXPR:
-    case CALL_EXPR:
-    default:
-      *decl = error_mark_node;
-      return;
-    }
-}
-
-/* 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)
-{
-  if ((left == error_mark_node)
-      || (right == error_mark_node))
-    return error_mark_node;
-
-  switch (TREE_CODE (tree_type))
-    {
-    case INTEGER_TYPE:
-      return ffecom_2 (TRUNC_DIV_EXPR, tree_type,
-		       left,
-		       right);
-
-    case COMPLEX_TYPE:
-      if (! optimize_size)
-	return ffecom_2 (RDIV_EXPR, tree_type,
-			 left,
-			 right);
-      {
-	ffecomGfrt ix;
-
-	if (TREE_TYPE (tree_type)
-	    == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1])
-	  ix = FFECOM_gfrtDIV_CC;	/* Overlapping result okay. */
-	else
-	  ix = FFECOM_gfrtDIV_ZZ;	/* Overlapping result okay. */
-
-	left = ffecom_1 (ADDR_EXPR,
-			 build_pointer_type (TREE_TYPE (left)),
-			 left);
-	left = build_tree_list (NULL_TREE, left);
-	right = ffecom_1 (ADDR_EXPR,
-			  build_pointer_type (TREE_TYPE (right)),
-			  right);
-	right = build_tree_list (NULL_TREE, right);
-	TREE_CHAIN (left) = right;
-
-	return ffecom_call_ (ffecom_gfrt_tree_ (ix),
-			     ffecom_gfrt_kindtype (ix),
-			     ffe_is_f2c_library (),
-			     tree_type,
-			     left,
-			     dest_tree, dest, dest_used,
-			     NULL_TREE, TRUE, hook);
-      }
-      break;
-
-    case RECORD_TYPE:
-      {
-	ffecomGfrt ix;
-
-	if (TREE_TYPE (TYPE_FIELDS (tree_type))
-	    == ffecom_tree_type [FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1])
-	  ix = FFECOM_gfrtDIV_CC;	/* Overlapping result okay. */
-	else
-	  ix = FFECOM_gfrtDIV_ZZ;	/* Overlapping result okay. */
-
-	left = ffecom_1 (ADDR_EXPR,
-			 build_pointer_type (TREE_TYPE (left)),
-			 left);
-	left = build_tree_list (NULL_TREE, left);
-	right = ffecom_1 (ADDR_EXPR,
-			  build_pointer_type (TREE_TYPE (right)),
-			  right);
-	right = build_tree_list (NULL_TREE, right);
-	TREE_CHAIN (left) = right;
-
-	return ffecom_call_ (ffecom_gfrt_tree_ (ix),
-			     ffecom_gfrt_kindtype (ix),
-			     ffe_is_f2c_library (),
-			     tree_type,
-			     left,
-			     dest_tree, dest, dest_used,
-			     NULL_TREE, TRUE, hook);
-      }
-      break;
-
-    default:
-      return ffecom_2 (RDIV_EXPR, tree_type,
-		       left,
-		       right);
-    }
-}
-
-/* Build type info for non-dummy variable.  */
-
-static tree
-ffecom_type_localvar_ (ffesymbol s, ffeinfoBasictype bt, ffeinfoKindtype kt)
-{
-  tree type;
-  ffebld dl;
-  ffebld dim;
-  tree lowt;
-  tree hight;
-
-  type = ffecom_tree_type[bt][kt];
-  if (bt == FFEINFO_basictypeCHARACTER)
-    {
-      hight = build_int_2 (ffesymbol_size (s), 0);
-      TREE_TYPE (hight) = ffecom_f2c_ftnlen_type_node;
-
-      type
-	= build_array_type
-	  (type,
-	   build_range_type (ffecom_f2c_ftnlen_type_node,
-			     ffecom_f2c_ftnlen_one_node,
-			     hight));
-      type = ffecom_check_size_overflow_ (s, type, FALSE);
-    }
-
-  for (dl = ffesymbol_dims (s); dl != NULL; dl = ffebld_trail (dl))
-    {
-      if (type == error_mark_node)
-	break;
-
-      dim = ffebld_head (dl);
-      assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
-
-      if (ffebld_left (dim) == NULL)
-	lowt = integer_one_node;
-      else
-	lowt = ffecom_expr (ffebld_left (dim));
-
-      if (TREE_CODE (lowt) != INTEGER_CST)
-	lowt = variable_size (lowt);
-
-      assert (ffebld_right (dim) != NULL);
-      hight = ffecom_expr (ffebld_right (dim));
-
-      if (TREE_CODE (hight) != INTEGER_CST)
-	hight = variable_size (hight);
-
-      type = build_array_type (type,
-			       build_range_type (ffecom_integer_type_node,
-						 lowt, hight));
-      type = ffecom_check_size_overflow_ (s, type, FALSE);
-    }
-
-  return type;
-}
-
-/* Build Namelist type.  */
-
-static GTY(()) tree ffecom_type_namelist_var;
-static tree
-ffecom_type_namelist_ (void)
-{
-  if (ffecom_type_namelist_var == NULL_TREE)
-    {
-      tree namefield, varsfield, nvarsfield, vardesctype, type;
-
-      vardesctype = ffecom_type_vardesc_ ();
-
-      type = make_node (RECORD_TYPE);
-
-      vardesctype = build_pointer_type (build_pointer_type (vardesctype));
-
-      namefield = ffecom_decl_field (type, NULL_TREE, "name",
-				     string_type_node);
-      varsfield = ffecom_decl_field (type, namefield, "vars", vardesctype);
-      nvarsfield = ffecom_decl_field (type, varsfield, "nvars",
-				      integer_type_node);
-
-      TYPE_FIELDS (type) = namefield;
-      layout_type (type);
-
-      ffecom_type_namelist_var = type;
-    }
-
-  return ffecom_type_namelist_var;
-}
-
-/* Build Vardesc type.  */
-
-static GTY(()) tree ffecom_type_vardesc_var;
-static tree
-ffecom_type_vardesc_ (void)
-{
-  if (ffecom_type_vardesc_var == NULL_TREE)
-    {
-      tree namefield, addrfield, dimsfield, typefield, type;
-      type = make_node (RECORD_TYPE);
-
-      namefield = ffecom_decl_field (type, NULL_TREE, "name",
-				     string_type_node);
-      addrfield = ffecom_decl_field (type, namefield, "addr",
-				     string_type_node);
-      dimsfield = ffecom_decl_field (type, addrfield, "dims",
-				     ffecom_f2c_ptr_to_ftnlen_type_node);
-      typefield = ffecom_decl_field (type, dimsfield, "type",
-				     integer_type_node);
-
-      TYPE_FIELDS (type) = namefield;
-      layout_type (type);
-
-      ffecom_type_vardesc_var = type;
-    }
-
-  return ffecom_type_vardesc_var;
-}
-
-static tree
-ffecom_vardesc_ (ffebld expr)
-{
-  ffesymbol s;
-
-  assert (ffebld_op (expr) == FFEBLD_opSYMTER);
-  s = ffebld_symter (expr);
-
-  if (ffesymbol_hook (s).vardesc_tree == NULL_TREE)
-    {
-      int i;
-      tree vardesctype = ffecom_type_vardesc_ ();
-      tree var;
-      tree nameinit;
-      tree dimsinit;
-      tree addrinit;
-      tree typeinit;
-      tree field;
-      tree varinits;
-      static int mynumber = 0;
-
-      var = build_decl (VAR_DECL,
-			ffecom_get_invented_identifier ("__g77_vardesc_%d",
-							mynumber++),
-			vardesctype);
-      TREE_STATIC (var) = 1;
-      DECL_INITIAL (var) = error_mark_node;
-
-      var = start_decl (var, FALSE);
-
-      /* Process inits.  */
-
-      nameinit = ffecom_build_f2c_string_ ((i = strlen (ffesymbol_text (s)))
-					   + 1,
-					   ffesymbol_text (s));
-      TREE_TYPE (nameinit)
-	= build_type_variant
-	(build_array_type
-	 (char_type_node,
-	  build_range_type (integer_type_node,
-			    integer_one_node,
-			    build_int_2 (i, 0))),
-	 1, 0);
-      TREE_CONSTANT (nameinit) = 1;
-      TREE_STATIC (nameinit) = 1;
-      nameinit = ffecom_1 (ADDR_EXPR,
-			   build_pointer_type (TREE_TYPE (nameinit)),
-			   nameinit);
-
-      addrinit = ffecom_arg_ptr_to_expr (expr, &typeinit);
-
-      dimsinit = ffecom_vardesc_dims_ (s);
-
-      if (typeinit == NULL_TREE)
-	{
-	  ffeinfoBasictype bt = ffesymbol_basictype (s);
-	  ffeinfoKindtype kt = ffesymbol_kindtype (s);
-	  int tc = ffecom_f2c_typecode (bt, kt);
-
-	  assert (tc != -1);
-	  typeinit = build_int_2 (tc, (tc < 0) ? -1 : 0);
-	}
-      else
-	typeinit = ffecom_1 (NEGATE_EXPR, TREE_TYPE (typeinit), typeinit);
-
-      varinits = build_tree_list ((field = TYPE_FIELDS (vardesctype)),
-				  nameinit);
-      TREE_CHAIN (varinits) = build_tree_list ((field = TREE_CHAIN (field)),
-					       addrinit);
-      TREE_CHAIN (TREE_CHAIN (varinits))
-	= build_tree_list ((field = TREE_CHAIN (field)), dimsinit);
-      TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (varinits)))
-	= build_tree_list ((field = TREE_CHAIN (field)), typeinit);
-
-      varinits = build_constructor (vardesctype, varinits);
-      TREE_CONSTANT (varinits) = 1;
-      TREE_STATIC (varinits) = 1;
-
-      finish_decl (var, varinits, FALSE);
-
-      var = ffecom_1 (ADDR_EXPR, build_pointer_type (vardesctype), var);
-
-      ffesymbol_hook (s).vardesc_tree = var;
-    }
-
-  return ffesymbol_hook (s).vardesc_tree;
-}
-
-static tree
-ffecom_vardesc_array_ (ffesymbol s)
-{
-  ffebld b;
-  tree list;
-  tree item = NULL_TREE;
-  tree var;
-  int i;
-  static int mynumber = 0;
-
-  for (i = 0, list = NULL_TREE, b = ffesymbol_namelist (s);
-       b != NULL;
-       b = ffebld_trail (b), ++i)
-    {
-      tree t;
-
-      t = ffecom_vardesc_ (ffebld_head (b));
-
-      if (list == NULL_TREE)
-	list = item = build_tree_list (NULL_TREE, t);
-      else
-	{
-	  TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
-	  item = TREE_CHAIN (item);
-	}
-    }
-
-  item = build_array_type (build_pointer_type (ffecom_type_vardesc_ ()),
-			   build_range_type (integer_type_node,
-					     integer_one_node,
-					     build_int_2 (i, 0)));
-  list = build_constructor (item, list);
-  TREE_CONSTANT (list) = 1;
-  TREE_STATIC (list) = 1;
-
-  var = ffecom_get_invented_identifier ("__g77_vardesc_array_%d", mynumber++);
-  var = build_decl (VAR_DECL, var, item);
-  TREE_STATIC (var) = 1;
-  DECL_INITIAL (var) = error_mark_node;
-  var = start_decl (var, FALSE);
-  finish_decl (var, list, FALSE);
-
-  return var;
-}
-
-static tree
-ffecom_vardesc_dims_ (ffesymbol s)
-{
-  if (ffesymbol_dims (s) == NULL)
-    return convert (ffecom_f2c_ptr_to_ftnlen_type_node,
-		    integer_zero_node);
-
-  {
-    ffebld b;
-    ffebld e;
-    tree list;
-    tree backlist;
-    tree item = NULL_TREE;
-    tree var;
-    tree numdim;
-    tree numelem;
-    tree baseoff = NULL_TREE;
-    static int mynumber = 0;
-
-    numdim = build_int_2 ((int) ffesymbol_rank (s), 0);
-    TREE_TYPE (numdim) = ffecom_f2c_ftnlen_type_node;
-
-    numelem = ffecom_expr (ffesymbol_arraysize (s));
-    TREE_TYPE (numelem) = ffecom_f2c_ftnlen_type_node;
-
-    list = NULL_TREE;
-    backlist = NULL_TREE;
-    for (b = ffesymbol_dims (s), e = ffesymbol_extents (s);
-	 b != NULL;
-	 b = ffebld_trail (b), e = ffebld_trail (e))
-      {
-	tree t;
-	tree low;
-	tree back;
-
-	if (ffebld_trail (b) == NULL)
-	  t = NULL_TREE;
-	else
-	  {
-	    t = convert (ffecom_f2c_ftnlen_type_node,
-			 ffecom_expr (ffebld_head (e)));
-
-	    if (list == NULL_TREE)
-	      list = item = build_tree_list (NULL_TREE, t);
-	    else
-	      {
-		TREE_CHAIN (item) = build_tree_list (NULL_TREE, t);
-		item = TREE_CHAIN (item);
-	      }
-	  }
-
-	if (ffebld_left (ffebld_head (b)) == NULL)
-	  low = ffecom_integer_one_node;
-	else
-	  low = ffecom_expr (ffebld_left (ffebld_head (b)));
-	low = convert (ffecom_f2c_ftnlen_type_node, low);
-
-	back = build_tree_list (low, t);
-	TREE_CHAIN (back) = backlist;
-	backlist = back;
-      }
-
-    for (item = backlist; item != NULL_TREE; item = TREE_CHAIN (item))
-      {
-	if (TREE_VALUE (item) == NULL_TREE)
-	  baseoff = TREE_PURPOSE (item);
-	else
-	  baseoff = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-			      TREE_PURPOSE (item),
-			      ffecom_2 (MULT_EXPR,
-					ffecom_f2c_ftnlen_type_node,
-					TREE_VALUE (item),
-					baseoff));
-      }
-
-    /* backlist now dead, along with all TREE_PURPOSEs on it.  */
-
-    baseoff = build_tree_list (NULL_TREE, baseoff);
-    TREE_CHAIN (baseoff) = list;
-
-    numelem = build_tree_list (NULL_TREE, numelem);
-    TREE_CHAIN (numelem) = baseoff;
-
-    numdim = build_tree_list (NULL_TREE, numdim);
-    TREE_CHAIN (numdim) = numelem;
-
-    item = build_array_type (ffecom_f2c_ftnlen_type_node,
-			     build_range_type (integer_type_node,
-					       integer_zero_node,
-					       build_int_2
-					       ((int) ffesymbol_rank (s)
-						+ 2, 0)));
-    list = build_constructor (item, numdim);
-    TREE_CONSTANT (list) = 1;
-    TREE_STATIC (list) = 1;
-
-    var = ffecom_get_invented_identifier ("__g77_dims_%d", mynumber++);
-    var = build_decl (VAR_DECL, var, item);
-    TREE_STATIC (var) = 1;
-    DECL_INITIAL (var) = error_mark_node;
-    var = start_decl (var, FALSE);
-    finish_decl (var, list, FALSE);
-
-    var = ffecom_1 (ADDR_EXPR, build_pointer_type (item), var);
-
-    return var;
-  }
-}
-
-/* Essentially does a "fold (build1 (code, type, node))" while checking
-   for certain housekeeping things.
-
-   NOTE: for building an ADDR_EXPR around a FUNCTION_DECL, use
-   ffecom_1_fn instead.  */
-
-tree
-ffecom_1 (enum tree_code code, tree type, tree node)
-{
-  tree item;
-
-  if ((node == error_mark_node)
-      || (type == error_mark_node))
-    return error_mark_node;
-
-  if (code == ADDR_EXPR)
-    {
-      if (!ffe_mark_addressable (node))
-	assert ("can't mark_addressable this node!" == NULL);
-    }
-
-  switch (ffe_is_emulate_complex () ? code : NOP_EXPR)
-    {
-      tree realtype;
-
-    case REALPART_EXPR:
-      item = build (COMPONENT_REF, type, node, TYPE_FIELDS (TREE_TYPE (node)));
-      break;
-
-    case IMAGPART_EXPR:
-      item = build (COMPONENT_REF, type, node, TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (node))));
-      break;
-
-
-    case NEGATE_EXPR:
-      if (TREE_CODE (type) != RECORD_TYPE)
-	{
-	  item = build1 (code, type, node);
-	  break;
-	}
-      node = ffecom_stabilize_aggregate_ (node);
-      realtype = TREE_TYPE (TYPE_FIELDS (type));
-      item =
-	ffecom_2 (COMPLEX_EXPR, type,
-		  ffecom_1 (NEGATE_EXPR, realtype,
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node)),
-		  ffecom_1 (NEGATE_EXPR, realtype,
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node)));
-      break;
-
-    default:
-      item = build1 (code, type, node);
-      break;
-    }
-
-  if (TREE_SIDE_EFFECTS (node))
-    TREE_SIDE_EFFECTS (item) = 1;
-  if (code == ADDR_EXPR && staticp (node))
-    TREE_CONSTANT (item) = 1;
-  else if (code == INDIRECT_REF)
-    TREE_READONLY (item) = TYPE_READONLY (type);
-  return fold (item);
-}
-
-/* Like ffecom_1 (ADDR_EXPR, TREE_TYPE (node), node), except
-   handles TREE_CODE (node) == FUNCTION_DECL.  In particular,
-   does not set TREE_ADDRESSABLE (because calling an inline
-   function does not mean the function needs to be separately
-   compiled).  */
-
-tree
-ffecom_1_fn (tree node)
-{
-  tree item;
-  tree type;
-
-  if (node == error_mark_node)
-    return error_mark_node;
-
-  type = build_type_variant (TREE_TYPE (node),
-			     TREE_READONLY (node),
-			     TREE_THIS_VOLATILE (node));
-  item = build1 (ADDR_EXPR,
-		 build_pointer_type (type), node);
-  if (TREE_SIDE_EFFECTS (node))
-    TREE_SIDE_EFFECTS (item) = 1;
-  if (staticp (node))
-    TREE_CONSTANT (item) = 1;
-  return fold (item);
-}
-
-/* Essentially does a "fold (build (code, type, node1, node2))" while
-   checking for certain housekeeping things.  */
-
-tree
-ffecom_2 (enum tree_code code, tree type, tree node1, tree node2)
-{
-  tree item;
-
-  if ((node1 == error_mark_node)
-      || (node2 == error_mark_node)
-      || (type == error_mark_node))
-    return error_mark_node;
-
-  switch (ffe_is_emulate_complex () ? code : NOP_EXPR)
-    {
-      tree a, b, c, d, realtype;
-
-    case CONJ_EXPR:
-      assert ("no CONJ_EXPR support yet" == NULL);
-      return error_mark_node;
-
-    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, item);
-      break;
-
-    case PLUS_EXPR:
-      if (TREE_CODE (type) != RECORD_TYPE)
-	{
-	  item = build (code, type, node1, node2);
-	  break;
-	}
-      node1 = ffecom_stabilize_aggregate_ (node1);
-      node2 = ffecom_stabilize_aggregate_ (node2);
-      realtype = TREE_TYPE (TYPE_FIELDS (type));
-      item =
-	ffecom_2 (COMPLEX_EXPR, type,
-		  ffecom_2 (PLUS_EXPR, realtype,
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node2)),
-		  ffecom_2 (PLUS_EXPR, realtype,
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node2)));
-      break;
-
-    case MINUS_EXPR:
-      if (TREE_CODE (type) != RECORD_TYPE)
-	{
-	  item = build (code, type, node1, node2);
-	  break;
-	}
-      node1 = ffecom_stabilize_aggregate_ (node1);
-      node2 = ffecom_stabilize_aggregate_ (node2);
-      realtype = TREE_TYPE (TYPE_FIELDS (type));
-      item =
-	ffecom_2 (COMPLEX_EXPR, type,
-		  ffecom_2 (MINUS_EXPR, realtype,
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node2)),
-		  ffecom_2 (MINUS_EXPR, realtype,
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node2)));
-      break;
-
-    case MULT_EXPR:
-      if (TREE_CODE (type) != RECORD_TYPE)
-	{
-	  item = build (code, type, node1, node2);
-	  break;
-	}
-      node1 = ffecom_stabilize_aggregate_ (node1);
-      node2 = ffecom_stabilize_aggregate_ (node2);
-      realtype = TREE_TYPE (TYPE_FIELDS (type));
-      a = save_expr (ffecom_1 (REALPART_EXPR, realtype,
-			       node1));
-      b = save_expr (ffecom_1 (IMAGPART_EXPR, realtype,
-			       node1));
-      c = save_expr (ffecom_1 (REALPART_EXPR, realtype,
-			       node2));
-      d = save_expr (ffecom_1 (IMAGPART_EXPR, realtype,
-			       node2));
-      item =
-	ffecom_2 (COMPLEX_EXPR, type,
-		  ffecom_2 (MINUS_EXPR, realtype,
-			    ffecom_2 (MULT_EXPR, realtype,
-				      a,
-				      c),
-			    ffecom_2 (MULT_EXPR, realtype,
-				      b,
-				      d)),
-		  ffecom_2 (PLUS_EXPR, realtype,
-			    ffecom_2 (MULT_EXPR, realtype,
-				      a,
-				      d),
-			    ffecom_2 (MULT_EXPR, realtype,
-				      c,
-				      b)));
-      break;
-
-    case EQ_EXPR:
-      if ((TREE_CODE (node1) != RECORD_TYPE)
-	  && (TREE_CODE (node2) != RECORD_TYPE))
-	{
-	  item = build (code, type, node1, node2);
-	  break;
-	}
-      assert (TREE_CODE (node1) == RECORD_TYPE);
-      assert (TREE_CODE (node2) == RECORD_TYPE);
-      node1 = ffecom_stabilize_aggregate_ (node1);
-      node2 = ffecom_stabilize_aggregate_ (node2);
-      realtype = TREE_TYPE (TYPE_FIELDS (type));
-      item =
-	ffecom_2 (TRUTH_ANDIF_EXPR, type,
-		  ffecom_2 (code, type,
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node2)),
-		  ffecom_2 (code, type,
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node2)));
-      break;
-
-    case NE_EXPR:
-      if ((TREE_CODE (node1) != RECORD_TYPE)
-	  && (TREE_CODE (node2) != RECORD_TYPE))
-	{
-	  item = build (code, type, node1, node2);
-	  break;
-	}
-      assert (TREE_CODE (node1) == RECORD_TYPE);
-      assert (TREE_CODE (node2) == RECORD_TYPE);
-      node1 = ffecom_stabilize_aggregate_ (node1);
-      node2 = ffecom_stabilize_aggregate_ (node2);
-      realtype = TREE_TYPE (TYPE_FIELDS (type));
-      item =
-	ffecom_2 (TRUTH_ORIF_EXPR, type,
-		  ffecom_2 (code, type,
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (REALPART_EXPR, realtype,
-				      node2)),
-		  ffecom_2 (code, type,
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node1),
-			    ffecom_1 (IMAGPART_EXPR, realtype,
-				      node2)));
-      break;
-
-    default:
-      item = build (code, type, node1, node2);
-      break;
-    }
-
-  if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2))
-    TREE_SIDE_EFFECTS (item) = 1;
-  return fold (item);
-}
-
-/* ffecom_2pass_advise_entrypoint -- Advise that there's this entrypoint
-
-   ffesymbol s;	 // the ENTRY point itself
-   if (ffecom_2pass_advise_entrypoint(s))
-       // the ENTRY point has been accepted
-
-   Does whatever compiler needs to do when it learns about the entrypoint,
-   like determine the return type of the master function, count the
-   number of entrypoints, etc.	Returns FALSE if the return type is
-   not compatible with the return type(s) of other entrypoint(s).
-
-   NOTE: for every call to this fn that returns TRUE, _do_entrypoint must
-   later (after _finish_progunit) be called with the same entrypoint(s)
-   as passed to this fn for which TRUE was returned.
-
-   03-Jan-92  JCB  2.0
-      Return FALSE if the return type conflicts with previous entrypoints.  */
-
-bool
-ffecom_2pass_advise_entrypoint (ffesymbol entry)
-{
-  ffebld list;			/* opITEM. */
-  ffebld mlist;			/* opITEM. */
-  ffebld plist;			/* opITEM. */
-  ffebld arg;			/* ffebld_head(opITEM). */
-  ffebld item;			/* opITEM. */
-  ffesymbol s;			/* ffebld_symter(arg). */
-  ffeinfoBasictype bt = ffesymbol_basictype (entry);
-  ffeinfoKindtype kt = ffesymbol_kindtype (entry);
-  ffetargetCharacterSize size = ffesymbol_size (entry);
-  bool ok;
-
-  if (ffecom_num_entrypoints_ == 0)
-    {				/* First entrypoint, make list of main
-				   arglist's dummies. */
-      assert (ffecom_primary_entry_ != NULL);
-
-      ffecom_master_bt_ = ffesymbol_basictype (ffecom_primary_entry_);
-      ffecom_master_kt_ = ffesymbol_kindtype (ffecom_primary_entry_);
-      ffecom_master_size_ = ffesymbol_size (ffecom_primary_entry_);
-
-      for (plist = NULL, list = ffesymbol_dummyargs (ffecom_primary_entry_);
-	   list != NULL;
-	   list = ffebld_trail (list))
-	{
-	  arg = ffebld_head (list);
-	  if (ffebld_op (arg) != FFEBLD_opSYMTER)
-	    continue;		/* Alternate return or some such thing. */
-	  item = ffebld_new_item (arg, NULL);
-	  if (plist == NULL)
-	    ffecom_master_arglist_ = item;
-	  else
-	    ffebld_set_trail (plist, item);
-	  plist = item;
-	}
-    }
-
-  /* If necessary, scan entry arglist for alternate returns.  Do this scan
-     apparently redundantly (it's done below to UNIONize the arglists) so
-     that we don't complain about RETURN 1 if an offending ENTRY is the only
-     one with an alternate return.  */
-
-  if (!ffecom_is_altreturning_)
-    {
-      for (list = ffesymbol_dummyargs (entry);
-	   list != NULL;
-	   list = ffebld_trail (list))
-	{
-	  arg = ffebld_head (list);
-	  if (ffebld_op (arg) == FFEBLD_opSTAR)
-	    {
-	      ffecom_is_altreturning_ = TRUE;
-	      break;
-	    }
-	}
-    }
-
-  /* Now check type compatibility. */
-
-  switch (ffecom_master_bt_)
-    {
-    case FFEINFO_basictypeNONE:
-      ok = (bt != FFEINFO_basictypeCHARACTER);
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      ok
-	= (bt == FFEINFO_basictypeCHARACTER)
-	&& (kt == ffecom_master_kt_)
-	&& (size == ffecom_master_size_);
-      break;
-
-    case FFEINFO_basictypeANY:
-      return FALSE;		/* Just don't bother. */
-
-    default:
-      if (bt == FFEINFO_basictypeCHARACTER)
-	{
-	  ok = FALSE;
-	  break;
-	}
-      ok = TRUE;
-      if ((bt != ffecom_master_bt_) || (kt != ffecom_master_kt_))
-	{
-	  ffecom_master_bt_ = FFEINFO_basictypeNONE;
-	  ffecom_master_kt_ = FFEINFO_kindtypeNONE;
-	}
-      break;
-    }
-
-  if (!ok)
-    {
-      ffebad_start (FFEBAD_ENTRY_CONFLICTS);
-      ffest_ffebad_here_current_stmt (0);
-      ffebad_finish ();
-      return FALSE;		/* Can't handle entrypoint. */
-    }
-
-  /* Entrypoint type compatible with previous types. */
-
-  ++ffecom_num_entrypoints_;
-
-  /* Master-arg-list = UNION(Master-arg-list,entry-arg-list). */
-
-  for (list = ffesymbol_dummyargs (entry);
-       list != NULL;
-       list = ffebld_trail (list))
-    {
-      arg = ffebld_head (list);
-      if (ffebld_op (arg) != FFEBLD_opSYMTER)
-	continue;		/* Alternate return or some such thing. */
-      s = ffebld_symter (arg);
-      for (plist = NULL, mlist = ffecom_master_arglist_;
-	   mlist != NULL;
-	   plist = mlist, mlist = ffebld_trail (mlist))
-	{			/* plist points to previous item for easy
-				   appending of arg. */
-	  if (ffebld_symter (ffebld_head (mlist)) == s)
-	    break;		/* Already have this arg in the master list. */
-	}
-      if (mlist != NULL)
-	continue;		/* Already have this arg in the master list. */
-
-      /* Append this arg to the master list. */
-
-      item = ffebld_new_item (arg, NULL);
-      if (plist == NULL)
-	ffecom_master_arglist_ = item;
-      else
-	ffebld_set_trail (plist, item);
-    }
-
-  return TRUE;
-}
-
-/* ffecom_2pass_do_entrypoint -- Do compilation of entrypoint
-
-   ffesymbol s;	 // the ENTRY point itself
-   ffecom_2pass_do_entrypoint(s);
-
-   Does whatever compiler needs to do to make the entrypoint actually
-   happen.  Must be called for each entrypoint after
-   ffecom_finish_progunit is called.  */
-
-void
-ffecom_2pass_do_entrypoint (ffesymbol entry)
-{
-  static int mfn_num = 0;
-  static int ent_num;
-
-  if (mfn_num != ffecom_num_fns_)
-    {				/* First entrypoint for this program unit. */
-      ent_num = 1;
-      mfn_num = ffecom_num_fns_;
-      ffecom_do_entry_ (ffecom_primary_entry_, 0);
-    }
-  else
-    ++ent_num;
-
-  --ffecom_num_entrypoints_;
-
-  ffecom_do_entry_ (entry, ent_num);
-}
-
-/* Essentially does a "fold (build (code, type, node1, node2))" while
-   checking for certain housekeeping things.  Always sets
-   TREE_SIDE_EFFECTS.  */
-
-tree
-ffecom_2s (enum tree_code code, tree type, tree node1, tree node2)
-{
-  tree item;
-
-  if ((node1 == error_mark_node)
-      || (node2 == error_mark_node)
-      || (type == error_mark_node))
-    return error_mark_node;
-
-  item = build (code, type, node1, node2);
-  TREE_SIDE_EFFECTS (item) = 1;
-  return fold (item);
-}
-
-/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
-   checking for certain housekeeping things.  */
-
-tree
-ffecom_3 (enum tree_code code, tree type, tree node1, tree node2, tree node3)
-{
-  tree item;
-
-  if ((node1 == error_mark_node)
-      || (node2 == error_mark_node)
-      || (node3 == error_mark_node)
-      || (type == error_mark_node))
-    return error_mark_node;
-
-  item = build (code, type, node1, node2, node3);
-  if (TREE_SIDE_EFFECTS (node1) || TREE_SIDE_EFFECTS (node2)
-      || (node3 != NULL_TREE && TREE_SIDE_EFFECTS (node3)))
-    TREE_SIDE_EFFECTS (item) = 1;
-  return fold (item);
-}
-
-/* Essentially does a "fold (build (code, type, node1, node2, node3))" while
-   checking for certain housekeeping things.  Always sets
-   TREE_SIDE_EFFECTS.  */
-
-tree
-ffecom_3s (enum tree_code code, tree type, tree node1, tree node2, tree node3)
-{
-  tree item;
-
-  if ((node1 == error_mark_node)
-      || (node2 == error_mark_node)
-      || (node3 == error_mark_node)
-      || (type == error_mark_node))
-    return error_mark_node;
-
-  item = build (code, type, node1, node2, node3);
-  TREE_SIDE_EFFECTS (item) = 1;
-  return fold (item);
-}
-
-/* ffecom_arg_expr -- Transform argument expr into gcc tree
-
-   See use by ffecom_list_expr.
-
-   If expression is NULL, returns an integer zero tree.	 If it is not
-   a CHARACTER expression, returns whatever ffecom_expr
-   returns and sets the length return value to NULL_TREE.  Otherwise
-   generates code to evaluate the character expression, returns the proper
-   pointer to the result, but does NOT set the length return value to a tree
-   that specifies the length of the result.  (In other words, the length
-   variable is always set to NULL_TREE, because a length is never passed.)
-
-   21-Dec-91  JCB  1.1
-      Don't set returned length, since nobody needs it (yet; someday if
-      we allow CHARACTER*(*) dummies to statement functions, we'll need
-      it).  */
-
-tree
-ffecom_arg_expr (ffebld expr, tree *length)
-{
-  tree ign;
-
-  *length = NULL_TREE;
-
-  if (expr == NULL)
-    return integer_zero_node;
-
-  if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
-    return ffecom_expr (expr);
-
-  return ffecom_arg_ptr_to_expr (expr, &ign);
-}
-
-/* Transform expression into constant argument-pointer-to-expression tree.
-
-   If the expression can be transformed into a argument-pointer-to-expression
-   tree that is constant, that is done, and the tree returned.  Else
-   NULL_TREE is returned.
-
-   That way, a caller can attempt to provide compile-time initialization
-   of a variable and, if that fails, *then* choose to start a new block
-   and resort to using temporaries, as appropriate.  */
-
-tree
-ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length)
-{
-  if (! expr)
-    return integer_zero_node;
-
-  if (ffebld_op (expr) == FFEBLD_opANY)
-    {
-      if (length)
-	*length = error_mark_node;
-      return error_mark_node;
-    }
-
-  if (ffebld_arity (expr) == 0
-      && (ffebld_op (expr) != FFEBLD_opSYMTER
-	  || ffebld_where (expr) == FFEINFO_whereCOMMON
-	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
-	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
-    {
-      tree t;
-
-      t = ffecom_arg_ptr_to_expr (expr, length);
-      assert (TREE_CONSTANT (t));
-      assert (! length || TREE_CONSTANT (*length));
-      return t;
-    }
-
-  if (length
-      && ffebld_size (expr) != FFETARGET_charactersizeNONE)
-    *length = build_int_2 (ffebld_size (expr), 0);
-  else if (length)
-    *length = NULL_TREE;
-  return NULL_TREE;
-}
-
-/* ffecom_arg_ptr_to_expr -- Transform argument expr into gcc tree
-
-   See use by ffecom_list_ptr_to_expr.
-
-   If expression is NULL, returns an integer zero tree.	 If it is not
-   a CHARACTER expression, returns whatever ffecom_ptr_to_expr
-   returns and sets the length return value to NULL_TREE.  Otherwise
-   generates code to evaluate the character expression, returns the proper
-   pointer to the result, AND sets the length return value to a tree that
-   specifies the length of the result.
-
-   If the length argument is NULL, this is a slightly special
-   case of building a FORMAT expression, that is, an expression that
-   will be used at run time without regard to length.  For the current
-   implementation, which uses the libf2c library, this means it is nice
-   to append a null byte to the end of the expression, where feasible,
-   to make sure any diagnostic about the FORMAT string terminates at
-   some useful point.
-
-   For now, treat %REF(char-expr) as the same as char-expr with a NULL
-   length argument.  This might even be seen as a feature, if a null
-   byte can always be appended.  */
-
-tree
-ffecom_arg_ptr_to_expr (ffebld expr, tree *length)
-{
-  tree item;
-  tree ign_length;
-  ffecomConcatList_ catlist;
-
-  if (length != NULL)
-    *length = NULL_TREE;
-
-  if (expr == NULL)
-    return integer_zero_node;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opPERCENT_VAL:
-      if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
-	return ffecom_expr (ffebld_left (expr));
-      {
-	tree temp_exp;
-	tree temp_length;
-
-	temp_exp = ffecom_arg_ptr_to_expr (ffebld_left (expr), &temp_length);
-	if (temp_exp == error_mark_node)
-	  return error_mark_node;
-
-	return ffecom_1 (INDIRECT_REF, TREE_TYPE (TREE_TYPE (temp_exp)),
-			 temp_exp);
-      }
-
-    case FFEBLD_opPERCENT_REF:
-      if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
-	return ffecom_ptr_to_expr (ffebld_left (expr));
-      if (length != NULL)
-	{
-	  ign_length = NULL_TREE;
-	  length = &ign_length;
-	}
-      expr = ffebld_left (expr);
-      break;
-
-    case FFEBLD_opPERCENT_DESCR:
-      switch (ffeinfo_basictype (ffebld_info (expr)))
-	{
-	case FFEINFO_basictypeCHARACTER:
-	  break;		/* Passed by descriptor anyway. */
-
-	default:
-	  item = ffecom_ptr_to_expr (expr);
-	  if (item != error_mark_node)
-	    *length = TYPE_SIZE (TREE_TYPE (TREE_TYPE (item)));
-	  break;
-	}
-      break;
-
-    default:
-      break;
-    }
-
-  if (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeCHARACTER)
-    return ffecom_ptr_to_expr (expr);
-
-  assert (ffeinfo_kindtype (ffebld_info (expr))
-	  == FFEINFO_kindtypeCHARACTER1);
-
-  while (ffebld_op (expr) == FFEBLD_opPAREN)
-    expr = ffebld_left (expr);
-
-  catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
-  switch (ffecom_concat_list_count_ (catlist))
-    {
-    case 0:			/* Shouldn't happen, but in case it does... */
-      if (length != NULL)
-	{
-	  *length = ffecom_f2c_ftnlen_zero_node;
-	  TREE_TYPE (*length) = ffecom_f2c_ftnlen_type_node;
-	}
-      ffecom_concat_list_kill_ (catlist);
-      return null_pointer_node;
-
-    case 1:			/* The (fairly) easy case. */
-      if (length == NULL)
-	ffecom_char_args_with_null_ (&item, &ign_length,
-				     ffecom_concat_list_expr_ (catlist, 0));
-      else
-	ffecom_char_args_ (&item, length,
-			   ffecom_concat_list_expr_ (catlist, 0));
-      ffecom_concat_list_kill_ (catlist);
-      assert (item != NULL_TREE);
-      return item;
-
-    default:			/* Must actually concatenate things. */
-      break;
-    }
-
-  {
-    int count = ffecom_concat_list_count_ (catlist);
-    int i;
-    tree lengths;
-    tree items;
-    tree length_array;
-    tree item_array;
-    tree citem;
-    tree clength;
-    tree temporary;
-    tree num;
-    tree known_length;
-    ffetargetCharacterSize sz;
-
-    sz = ffecom_concat_list_maxlen_ (catlist);
-    /* ~~Kludge! */
-    assert (sz != FFETARGET_charactersizeNONE);
-
-    {
-      tree hook;
-
-      hook = ffebld_nonter_hook (expr);
-      assert (hook);
-      assert (TREE_CODE (hook) == TREE_VEC);
-      assert (TREE_VEC_LENGTH (hook) == 3);
-      length_array = lengths = TREE_VEC_ELT (hook, 0);
-      item_array = items = TREE_VEC_ELT (hook, 1);
-      temporary = TREE_VEC_ELT (hook, 2);
-    }
-
-    known_length = ffecom_f2c_ftnlen_zero_node;
-
-    for (i = 0; i < count; ++i)
-      {
-	if ((i == count)
-	    && (length == NULL))
-	  ffecom_char_args_with_null_ (&citem, &clength,
-				       ffecom_concat_list_expr_ (catlist, i));
-	else
-	  ffecom_char_args_ (&citem, &clength,
-			     ffecom_concat_list_expr_ (catlist, i));
-	if ((citem == error_mark_node)
-	    || (clength == error_mark_node))
-	  {
-	    ffecom_concat_list_kill_ (catlist);
-	    *length = error_mark_node;
-	    return error_mark_node;
-	  }
-
-	items
-	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (items),
-		      ffecom_modify (void_type_node,
-				     ffecom_2 (ARRAY_REF,
-		     TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (item_array))),
-					       item_array,
-					       build_int_2 (i, 0)),
-				     citem),
-		      items);
-	clength = ffecom_save_tree (clength);
-	if (length != NULL)
-	  known_length
-	    = ffecom_2 (PLUS_EXPR, ffecom_f2c_ftnlen_type_node,
-			known_length,
-			clength);
-	lengths
-	  = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (lengths),
-		      ffecom_modify (void_type_node,
-				     ffecom_2 (ARRAY_REF,
-		   TYPE_MAIN_VARIANT (TREE_TYPE (TREE_TYPE (length_array))),
-					       length_array,
-					       build_int_2 (i, 0)),
-				     clength),
-		      lengths);
-      }
-
-    temporary = ffecom_1 (ADDR_EXPR,
-			  build_pointer_type (TREE_TYPE (temporary)),
-			  temporary);
-
-    item = build_tree_list (NULL_TREE, temporary);
-    TREE_CHAIN (item)
-      = build_tree_list (NULL_TREE,
-			 ffecom_1 (ADDR_EXPR,
-				   build_pointer_type (TREE_TYPE (items)),
-				   items));
-    TREE_CHAIN (TREE_CHAIN (item))
-      = build_tree_list (NULL_TREE,
-			 ffecom_1 (ADDR_EXPR,
-				   build_pointer_type (TREE_TYPE (lengths)),
-				   lengths));
-    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item)))
-      = build_tree_list
-	(NULL_TREE,
-	 ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
-		   convert (ffecom_f2c_ftnlen_type_node,
-			    build_int_2 (count, 0))));
-    num = build_int_2 (sz, 0);
-    TREE_TYPE (num) = ffecom_f2c_ftnlen_type_node;
-    TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (item))))
-      = build_tree_list (NULL_TREE, num);
-
-    item = ffecom_call_gfrt (FFECOM_gfrtCAT, item, NULL_TREE);
-    TREE_SIDE_EFFECTS (item) = 1;
-    item = ffecom_2 (COMPOUND_EXPR, TREE_TYPE (temporary),
-		     item,
-		     temporary);
-
-    if (length != NULL)
-      *length = known_length;
-  }
-
-  ffecom_concat_list_kill_ (catlist);
-  assert (item != NULL_TREE);
-  return item;
-}
-
-/* Generate call to run-time function.
-
-   The first arg is the GNU Fortran Run-Time function index, the second
-   arg is the list of arguments to pass to it.	Returned is the expression
-   (WITHOUT TREE_SIDE_EFFECTS set!) that makes the call and returns the
-   result (which may be void).	*/
-
-tree
-ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook)
-{
-  return ffecom_call_ (ffecom_gfrt_tree_ (ix),
-		       ffecom_gfrt_kindtype (ix),
-		       ffe_is_f2c_library () && ffecom_gfrt_complex_[ix],
-		       NULL_TREE, args, NULL_TREE, NULL,
-		       NULL, NULL_TREE, TRUE, hook);
-}
-
-/* Transform constant-union to tree.  */
-
-tree
-ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
-		      ffeinfoKindtype kt, tree tree_type)
-{
-  tree item;
-
-  switch (bt)
-    {
-    case FFEINFO_basictypeINTEGER:
-      {
-        HOST_WIDE_INT hi, lo;
-
-	switch (kt)
-	  {
-#if FFETARGET_okINTEGER1
-	  case FFEINFO_kindtypeINTEGER1:
-	    lo = ffebld_cu_val_integer1 (*cu);
-	    hi = (lo < 0) ? -1 : 0;
-	    break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	  case FFEINFO_kindtypeINTEGER2:
-	    lo = ffebld_cu_val_integer2 (*cu);
-	    hi = (lo < 0) ? -1 : 0;
-	    break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	  case FFEINFO_kindtypeINTEGER3:
-	    lo = ffebld_cu_val_integer3 (*cu);
-	    hi = (lo < 0) ? -1 : 0;
-	    break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	  case FFEINFO_kindtypeINTEGER4:
-#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
-
-	  default:
-	    assert ("bad INTEGER constant kind type" == NULL);
-	    /* Fall through. */
-	  case FFEINFO_kindtypeANY:
-	    return error_mark_node;
-	  }
-	item = build_int_2 (lo, hi);
-	TREE_TYPE (item) = tree_type;
-      }
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      {
-	int val;
-
-	switch (kt)
-	  {
-#if FFETARGET_okLOGICAL1
-	  case FFEINFO_kindtypeLOGICAL1:
-	    val = ffebld_cu_val_logical1 (*cu);
-	    break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	  case FFEINFO_kindtypeLOGICAL2:
-	    val = ffebld_cu_val_logical2 (*cu);
-	    break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	  case FFEINFO_kindtypeLOGICAL3:
-	    val = ffebld_cu_val_logical3 (*cu);
-	    break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	  case FFEINFO_kindtypeLOGICAL4:
-	    val = ffebld_cu_val_logical4 (*cu);
-	    break;
-#endif
-
-	  default:
-	    assert ("bad LOGICAL constant kind type" == NULL);
-	    /* Fall through. */
-	  case FFEINFO_kindtypeANY:
-	    return error_mark_node;
-	  }
-	item = build_int_2 (val, (val < 0) ? -1 : 0);
-	TREE_TYPE (item) = tree_type;
-      }
-      break;
-
-    case FFEINFO_basictypeREAL:
-      {
-	REAL_VALUE_TYPE val;
-
-	switch (kt)
-	  {
-#if FFETARGET_okREAL1
-	  case FFEINFO_kindtypeREAL1:
-	    val = ffetarget_value_real1 (ffebld_cu_val_real1 (*cu));
-	    break;
-#endif
-
-#if FFETARGET_okREAL2
-	  case FFEINFO_kindtypeREAL2:
-	    val = ffetarget_value_real2 (ffebld_cu_val_real2 (*cu));
-	    break;
-#endif
-
-#if FFETARGET_okREAL3
-	  case FFEINFO_kindtypeREAL3:
-	    val = ffetarget_value_real3 (ffebld_cu_val_real3 (*cu));
-	    break;
-#endif
-
-	  default:
-	    assert ("bad REAL constant kind type" == NULL);
-	    /* Fall through. */
-	  case FFEINFO_kindtypeANY:
-	    return error_mark_node;
-	  }
-	item = build_real (tree_type, val);
-      }
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      {
-	REAL_VALUE_TYPE real;
-	REAL_VALUE_TYPE imag;
-	tree el_type = ffecom_tree_type[FFEINFO_basictypeREAL][kt];
-
-	switch (kt)
-	  {
-#if FFETARGET_okCOMPLEX1
-	  case FFEINFO_kindtypeREAL1:
-	    real = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).real);
-	    imag = ffetarget_value_real1 (ffebld_cu_val_complex1 (*cu).imaginary);
-	    break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	  case FFEINFO_kindtypeREAL2:
-	    real = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).real);
-	    imag = ffetarget_value_real2 (ffebld_cu_val_complex2 (*cu).imaginary);
-	    break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	  case FFEINFO_kindtypeREAL3:
-	    real = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).real);
-	    imag = ffetarget_value_real3 (ffebld_cu_val_complex3 (*cu).imaginary);
-	    break;
-#endif
-
-	  default:
-	    assert ("bad REAL constant kind type" == NULL);
-	    /* Fall through. */
-	  case FFEINFO_kindtypeANY:
-	    return error_mark_node;
-	  }
-	item = ffecom_build_complex_constant_ (tree_type,
-					       build_real (el_type, real),
-					       build_real (el_type, imag));
-      }
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      {				/* Happens only in DATA and similar contexts. */
-	ffetargetCharacter1 val;
-
-	switch (kt)
-	  {
-#if FFETARGET_okCHARACTER1
-	  case FFEINFO_kindtypeLOGICAL1:
-	    val = ffebld_cu_val_character1 (*cu);
-	    break;
-#endif
-
-	  default:
-	    assert ("bad CHARACTER constant kind type" == NULL);
-	    /* Fall through. */
-	  case FFEINFO_kindtypeANY:
-	    return error_mark_node;
-	  }
-	item = build_string (ffetarget_length_character1 (val),
-			     ffetarget_text_character1 (val));
-	TREE_TYPE (item)
-	  = build_type_variant (build_array_type (char_type_node,
-						  build_range_type
-						  (integer_type_node,
-						   integer_one_node,
-						   build_int_2
-						(ffetarget_length_character1
-						 (val), 0))),
-				1, 0);
-      }
-      break;
-
-    case FFEINFO_basictypeHOLLERITH:
-      {
-	ffetargetHollerith h;
-
-	h = ffebld_cu_val_hollerith (*cu);
-
-	/* If not at least as wide as default INTEGER, widen it.  */
-	if (h.length >= FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE)
-	  item = build_string (h.length, h.text);
-	else
-	  {
-	    char str[FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE];
-
-	    memcpy (str, h.text, h.length);
-	    memset (&str[h.length], ' ',
-		    FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE
-		    - h.length);
-	    item = build_string (FLOAT_TYPE_SIZE / CHAR_TYPE_SIZE,
-				 str);
-	  }
-	TREE_TYPE (item)
-	  = build_type_variant (build_array_type (char_type_node,
-						  build_range_type
-						  (integer_type_node,
-						   integer_one_node,
-						   build_int_2
-						   (h.length, 0))),
-				1, 0);
-      }
-      break;
-
-    case FFEINFO_basictypeTYPELESS:
-      {
-	ffetargetInteger1 ival;
-	ffetargetTypeless tless;
-	ffebad error;
-
-	tless = ffebld_cu_val_typeless (*cu);
-	error = ffetarget_convert_integer1_typeless (&ival, tless);
-	assert (error == FFEBAD);
-
-	item = build_int_2 ((int) ival, 0);
-      }
-      break;
-
-    default:
-      assert ("not yet on constant type" == NULL);
-      /* Fall through. */
-    case FFEINFO_basictypeANY:
-      return error_mark_node;
-    }
-
-  TREE_CONSTANT (item) = 1;
-
-  return item;
-}
-
-/* Transform constant-union to tree, with the type known.  */
-
-tree
-ffecom_constantunion_with_type (ffebldConstantUnion *cu, tree tree_type,
-				ffebldConst ct)
-{
-  tree item;
-
-  int val;
-
-  switch (ct)
-  {
-#if FFETARGET_okINTEGER1
-	  case  FFEBLD_constINTEGER1:
-	  val = ffebld_cu_val_integer1 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#endif
-#if FFETARGET_okINTEGER2
-	  case  FFEBLD_constINTEGER2:
-		  val = ffebld_cu_val_integer2 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#endif
-#if FFETARGET_okINTEGER3
-	  case  FFEBLD_constINTEGER3:
-		  val = ffebld_cu_val_integer3 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#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
-	  case  FFEBLD_constLOGICAL1:
-		  val = ffebld_cu_val_logical1 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#endif
-#if FFETARGET_okLOGICAL2
-          case  FFEBLD_constLOGICAL2:
-		  val = ffebld_cu_val_logical2 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#endif
-#if FFETARGET_okLOGICAL3
-	  case  FFEBLD_constLOGICAL3:
-		  val = ffebld_cu_val_logical3 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#endif
-#if FFETARGET_okLOGICAL4
-	  case  FFEBLD_constLOGICAL4:
-		  val = ffebld_cu_val_logical4 (*cu);
-		  item = build_int_2 (val, (val < 0) ? -1 : 0);
-		  break;
-#endif
-	  default:
-		  assert ("constant type not supported"==NULL);
-		  return error_mark_node;
-		  break;
-  }
-
-  TREE_TYPE (item) = tree_type;
-
-  TREE_CONSTANT (item) = 1;
-
-  return item;
-}
-/* Transform expression into constant tree.
-
-   If the expression can be transformed into a tree that is constant,
-   that is done, and the tree returned.  Else NULL_TREE is returned.
-
-   That way, a caller can attempt to provide compile-time initialization
-   of a variable and, if that fails, *then* choose to start a new block
-   and resort to using temporaries, as appropriate.  */
-
-tree
-ffecom_const_expr (ffebld expr)
-{
-  if (! expr)
-    return integer_zero_node;
-
-  if (ffebld_op (expr) == FFEBLD_opANY)
-    return error_mark_node;
-
-  if (ffebld_arity (expr) == 0
-      && (ffebld_op (expr) != FFEBLD_opSYMTER
-	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
-	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
-    {
-      tree t;
-
-      t = ffecom_expr (expr);
-      assert (TREE_CONSTANT (t));
-      return t;
-    }
-
-  return NULL_TREE;
-}
-
-/* Handy way to make a field in a struct/union.  */
-
-tree
-ffecom_decl_field (tree context, tree prevfield, const char *name, tree type)
-{
-  tree field;
-
-  field = build_decl (FIELD_DECL, get_identifier (name), type);
-  DECL_CONTEXT (field) = context;
-  DECL_ALIGN (field) = 0;
-  DECL_USER_ALIGN (field) = 0;
-  if (prevfield != NULL_TREE)
-    TREE_CHAIN (prevfield) = field;
-
-  return field;
-}
-
-void
-ffecom_close_include (FILE *f)
-{
-  ffecom_close_include_ (f);
-}
-
-/* End a compound statement (block).  */
-
-tree
-ffecom_end_compstmt (void)
-{
-  return bison_rule_compstmt_ ();
-}
-
-/* ffecom_end_transition -- Perform end transition on all symbols
-
-   ffecom_end_transition();
-
-   Calls ffecom_sym_end_transition for each global and local symbol.  */
-
-void
-ffecom_end_transition (void)
-{
-  ffebld item;
-
-  if (ffe_is_ffedebug ())
-    fprintf (dmpout, "; end_stmt_transition\n");
-
-  ffecom_list_blockdata_ = NULL;
-  ffecom_list_common_ = NULL;
-
-  ffesymbol_drive (ffecom_sym_end_transition);
-  if (ffe_is_ffedebug ())
-    {
-      ffestorag_report ();
-    }
-
-  ffecom_start_progunit_ ();
-
-  for (item = ffecom_list_blockdata_;
-       item != NULL;
-       item = ffebld_trail (item))
-    {
-      ffebld callee;
-      ffesymbol s;
-      tree dt;
-      tree t;
-      tree var;
-      static int number = 0;
-
-      callee = ffebld_head (item);
-      s = ffebld_symter (callee);
-      t = ffesymbol_hook (s).decl_tree;
-      if (t == NULL_TREE)
-	{
-	  s = ffecom_sym_transform_ (s);
-	  t = ffesymbol_hook (s).decl_tree;
-	}
-
-      dt = build_pointer_type (TREE_TYPE (t));
-
-      var = build_decl (VAR_DECL,
-			ffecom_get_invented_identifier ("__g77_forceload_%d",
-							number++),
-			dt);
-      DECL_EXTERNAL (var) = 0;
-      TREE_STATIC (var) = 1;
-      TREE_PUBLIC (var) = 0;
-      DECL_INITIAL (var) = error_mark_node;
-      TREE_USED (var) = 1;
-
-      var = start_decl (var, FALSE);
-
-      t = ffecom_1 (ADDR_EXPR, dt, t);
-
-      finish_decl (var, t, FALSE);
-    }
-
-  /* This handles any COMMON areas that weren't referenced but have, for
-     example, important initial data.  */
-
-  for (item = ffecom_list_common_;
-       item != NULL;
-       item = ffebld_trail (item))
-    ffecom_transform_common_ (ffebld_symter (ffebld_head (item)));
-
-  ffecom_list_common_ = NULL;
-}
-
-/* ffecom_exec_transition -- Perform exec transition on all symbols
-
-   ffecom_exec_transition();
-
-   Calls ffecom_sym_exec_transition for each global and local symbol.
-   Make sure error updating not inhibited.  */
-
-void
-ffecom_exec_transition (void)
-{
-  bool inhibited;
-
-  if (ffe_is_ffedebug ())
-    fprintf (dmpout, "; exec_stmt_transition\n");
-
-  inhibited = ffebad_inhibit ();
-  ffebad_set_inhibit (FALSE);
-
-  ffesymbol_drive (ffecom_sym_exec_transition);	/* Don't retract! */
-  ffeequiv_exec_transition ();	/* Handle all pending EQUIVALENCEs. */
-  if (ffe_is_ffedebug ())
-    {
-      ffestorag_report ();
-    }
-
-  if (inhibited)
-    ffebad_set_inhibit (TRUE);
-}
-
-/* Handle assignment statement.
-
-   Convert dest and source using ffecom_expr, then join them
-   with an ASSIGN op and pass the whole thing to expand_expr_stmt.  */
-
-void
-ffecom_expand_let_stmt (ffebld dest, ffebld source)
-{
-  tree dest_tree;
-  tree dest_length;
-  tree source_tree;
-  tree expr_tree;
-
-  if (ffeinfo_basictype (ffebld_info (dest)) != FFEINFO_basictypeCHARACTER)
-    {
-      bool dest_used;
-      tree assign_temp;
-
-      /* This attempts to replicate the test below, but must not be
-	 true when the test below is false.  (Always err on the side
-	 of creating unused temporaries, to avoid ICEs.)  */
-      if (ffebld_op (dest) != FFEBLD_opSYMTER
-	  || ((dest_tree = ffesymbol_hook (ffebld_symter (dest)).decl_tree)
-	      && (TREE_CODE (dest_tree) != VAR_DECL
-		  || TREE_ADDRESSABLE (dest_tree))))
-	{
-	  ffecom_prepare_expr_ (source, dest);
-	  dest_used = TRUE;
-	}
-      else
-	{
-	  ffecom_prepare_expr_ (source, NULL);
-	  dest_used = FALSE;
-	}
-
-      ffecom_prepare_expr_w (NULL_TREE, dest);
-
-      /* For COMPLEX assignment like C1=C2, if partial overlap is possible,
-	 create a temporary through which the assignment is to take place,
-	 since MODIFY_EXPR doesn't handle partial overlap properly.  */
-      if (ffebld_basictype (dest) == FFEINFO_basictypeCOMPLEX
-	  && ffecom_possible_partial_overlap_ (dest, source))
-	{
-	  assign_temp = ffecom_make_tempvar ("complex_let",
-					     ffecom_tree_type
-					     [ffebld_basictype (dest)]
-					     [ffebld_kindtype (dest)],
-					     FFETARGET_charactersizeNONE,
-					     -1);
-	}
-      else
-	assign_temp = NULL_TREE;
-
-      ffecom_prepare_end ();
-
-      dest_tree = ffecom_expr_w (NULL_TREE, dest);
-      if (dest_tree == error_mark_node)
-	return;
-
-      if ((TREE_CODE (dest_tree) != VAR_DECL)
-	  || TREE_ADDRESSABLE (dest_tree))
-	source_tree = ffecom_expr_ (source, dest_tree, dest, &dest_used,
-				    FALSE, FALSE);
-      else
-	{
-	  assert (! dest_used);
-	  dest_used = FALSE;
-	  source_tree = ffecom_expr (source);
-	}
-      if (source_tree == error_mark_node)
-	return;
-
-      if (dest_used)
-	expr_tree = source_tree;
-      else if (assign_temp)
-	{
-	  expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
-				 assign_temp,
-				 source_tree);
-	  expand_expr_stmt (expr_tree);
-	  expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
-				 dest_tree,
-				 assign_temp);
-	}
-      else
-	expr_tree = ffecom_2s (MODIFY_EXPR, void_type_node,
-			       dest_tree,
-			       source_tree);
-
-      expand_expr_stmt (expr_tree);
-      return;
-    }
-
-  ffecom_prepare_let_char_ (ffebld_size_known (dest), source);
-  ffecom_prepare_expr_w (NULL_TREE, dest);
-
-  ffecom_prepare_end ();
-
-  ffecom_char_args_ (&dest_tree, &dest_length, dest);
-  ffecom_let_char_ (dest_tree, dest_length, ffebld_size_known (dest),
-		    source);
-}
-
-/* ffecom_expr -- Transform expr into gcc tree
-
-   tree t;
-   ffebld expr;	 // FFE expression.
-   tree = ffecom_expr(expr);
-
-   Recursive descent on expr while making corresponding tree nodes and
-   attaching type info and such.  */
-
-tree
-ffecom_expr (ffebld expr)
-{
-  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, FALSE, FALSE);
-}
-
-/* Like ffecom_expr, but return tree usable for assigned GOTO or FORMAT.  */
-
-tree
-ffecom_expr_assign (ffebld expr)
-{
-  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE);
-}
-
-/* Like ffecom_expr_rw, but return tree usable for ASSIGN.  */
-
-tree
-ffecom_expr_assign_w (ffebld expr)
-{
-  return ffecom_expr_ (expr, NULL_TREE, NULL, NULL, TRUE, FALSE);
-}
-
-/* Transform expr for use as into read/write tree and stabilize the
-   reference.  Not for use on CHARACTER expressions.
-
-   Recursive descent on expr while making corresponding tree nodes and
-   attaching type info and such.  */
-
-tree
-ffecom_expr_rw (tree type, ffebld expr)
-{
-  assert (expr != NULL);
-  /* Different target types not yet supported.  */
-  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
-
-  return stabilize_reference (ffecom_expr (expr));
-}
-
-/* Transform expr for use as into write tree and stabilize the
-   reference.  Not for use on CHARACTER expressions.
-
-   Recursive descent on expr while making corresponding tree nodes and
-   attaching type info and such.  */
-
-tree
-ffecom_expr_w (tree type, ffebld expr)
-{
-  assert (expr != NULL);
-  /* Different target types not yet supported.  */
-  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
-
-  return stabilize_reference (ffecom_expr (expr));
-}
-
-/* Do global stuff.  */
-
-void
-ffecom_finish_compile (void)
-{
-  assert (ffecom_outer_function_decl_ == NULL_TREE);
-  assert (current_function_decl == NULL_TREE);
-
-  ffeglobal_drive (ffecom_finish_global_);
-}
-
-/* Public entry point for front end to access finish_decl.  */
-
-void
-ffecom_finish_decl (tree decl, tree init, bool is_top_level)
-{
-  assert (!is_top_level);
-  finish_decl (decl, init, FALSE);
-}
-
-/* Finish a program unit.  */
-
-void
-ffecom_finish_progunit (void)
-{
-  ffecom_end_compstmt ();
-
-  ffecom_previous_function_decl_ = current_function_decl;
-  ffecom_which_entrypoint_decl_ = NULL_TREE;
-
-  finish_function (0);
-}
-
-/* Wrapper for get_identifier.  pattern is sprintf-like.  */
-
-tree
-ffecom_get_invented_identifier (const char *pattern, ...)
-{
-  tree decl;
-  char *nam;
-  va_list ap;
-
-  va_start (ap, pattern);
-  if (vasprintf (&nam, pattern, ap) == 0)
-    abort ();
-  va_end (ap);
-  decl = get_identifier (nam);
-  free (nam);
-  IDENTIFIER_INVENTED (decl) = 1;
-  return decl;
-}
-
-ffeinfoBasictype
-ffecom_gfrt_basictype (ffecomGfrt gfrt)
-{
-  assert (gfrt < FFECOM_gfrt);
-
-  switch (ffecom_gfrt_type_[gfrt])
-    {
-    case FFECOM_rttypeVOID_:
-    case FFECOM_rttypeVOIDSTAR_:
-      return FFEINFO_basictypeNONE;
-
-    case FFECOM_rttypeFTNINT_:
-      return FFEINFO_basictypeINTEGER;
-
-    case FFECOM_rttypeINTEGER_:
-      return FFEINFO_basictypeINTEGER;
-
-    case FFECOM_rttypeLONGINT_:
-      return FFEINFO_basictypeINTEGER;
-
-    case FFECOM_rttypeLOGICAL_:
-      return FFEINFO_basictypeLOGICAL;
-
-    case FFECOM_rttypeREAL_F2C_:
-    case FFECOM_rttypeREAL_GNU_:
-      return FFEINFO_basictypeREAL;
-
-    case FFECOM_rttypeCOMPLEX_F2C_:
-    case FFECOM_rttypeCOMPLEX_GNU_:
-      return FFEINFO_basictypeCOMPLEX;
-
-    case FFECOM_rttypeDOUBLE_:
-    case FFECOM_rttypeDOUBLEREAL_:
-      return FFEINFO_basictypeREAL;
-
-    case FFECOM_rttypeDBLCMPLX_F2C_:
-    case FFECOM_rttypeDBLCMPLX_GNU_:
-      return FFEINFO_basictypeCOMPLEX;
-
-    case FFECOM_rttypeCHARACTER_:
-      return FFEINFO_basictypeCHARACTER;
-
-    default:
-      return FFEINFO_basictypeANY;
-    }
-}
-
-ffeinfoKindtype
-ffecom_gfrt_kindtype (ffecomGfrt gfrt)
-{
-  assert (gfrt < FFECOM_gfrt);
-
-  switch (ffecom_gfrt_type_[gfrt])
-    {
-    case FFECOM_rttypeVOID_:
-    case FFECOM_rttypeVOIDSTAR_:
-      return FFEINFO_kindtypeNONE;
-
-    case FFECOM_rttypeFTNINT_:
-      return FFEINFO_kindtypeINTEGER1;
-
-    case FFECOM_rttypeINTEGER_:
-      return FFEINFO_kindtypeINTEGER1;
-
-    case FFECOM_rttypeLONGINT_:
-      return FFEINFO_kindtypeINTEGER4;
-
-    case FFECOM_rttypeLOGICAL_:
-      return FFEINFO_kindtypeLOGICAL1;
-
-    case FFECOM_rttypeREAL_F2C_:
-    case FFECOM_rttypeREAL_GNU_:
-      return FFEINFO_kindtypeREAL1;
-
-    case FFECOM_rttypeCOMPLEX_F2C_:
-    case FFECOM_rttypeCOMPLEX_GNU_:
-      return FFEINFO_kindtypeREAL1;
-
-    case FFECOM_rttypeDOUBLE_:
-    case FFECOM_rttypeDOUBLEREAL_:
-      return FFEINFO_kindtypeREAL2;
-
-    case FFECOM_rttypeDBLCMPLX_F2C_:
-    case FFECOM_rttypeDBLCMPLX_GNU_:
-      return FFEINFO_kindtypeREAL2;
-
-    case FFECOM_rttypeCHARACTER_:
-      return FFEINFO_kindtypeCHARACTER1;
-
-    default:
-      return FFEINFO_kindtypeANY;
-    }
-}
-
-void
-ffecom_init_0 (void)
-{
-  tree endlink;
-  int i;
-  int j;
-  tree t;
-  tree field;
-  ffetype type;
-  ffetype base_type;
-  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
-     whether the compiler environment is buggy in known ways, some of which
-     would, if not explicitly checked here, result in subtle bugs in g77.  */
-
-  if (ffe_is_do_internal_checks ())
-    {
-      static const char names[][12]
-	=
-      {"bar", "bletch", "foo", "foobar"};
-      const char *name;
-      unsigned long ul;
-      double fl;
-
-      name = bsearch ("foo", &names[0], ARRAY_SIZE (names), sizeof (names[0]),
-		      (int (*)(const void *, const void *)) strcmp);
-      if (name != &names[2][0])
-	{
-	  assert ("bsearch doesn't work, #define FFEPROJ_BSEARCH 0 in proj.h"
-		  == NULL);
-	  abort ();
-	}
-
-      ul = strtoul ("123456789", NULL, 10);
-      if (ul != 123456789L)
-	{
-	  assert ("strtoul doesn't have enough range, #define FFEPROJ_STRTOUL 0\
- in proj.h" == NULL);
-	  abort ();
-	}
-
-      fl = atof ("56.789");
-      if ((fl < 56.788) || (fl > 56.79))
-	{
-	  assert ("atof not type double, fix your #include <stdio.h>"
-		  == NULL);
-	  abort ();
-	}
-    }
-
-  ffecom_outer_function_decl_ = NULL_TREE;
-  current_function_decl = NULL_TREE;
-  named_labels = NULL_TREE;
-  current_binding_level = NULL_BINDING_LEVEL;
-  free_binding_level = NULL_BINDING_LEVEL;
-  /* Make the binding_level structure for global names.  */
-  pushlevel (0);
-  global_binding_level = current_binding_level;
-  current_binding_level->prep_state = 2;
-
-  build_common_tree_nodes (1);
-
-  /* Define `int' and `char' first so that dbx will output them first.  */
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("int"),
-			integer_type_node));
-  /* CHARACTER*1 is unsigned in ICHAR contexts.  */
-  char_type_node = make_unsigned_type (CHAR_TYPE_SIZE);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("char"),
-			char_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("long int"),
-			long_integer_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned int"),
-			unsigned_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("long unsigned int"),
-			long_unsigned_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("long long int"),
-			long_long_integer_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("long long unsigned int"),
-			long_long_unsigned_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("short int"),
-			short_integer_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("short unsigned int"),
-			short_unsigned_type_node));
-
-  /* Set the sizetype before we make other types.  This *should* be the
-     first type we create.  */
-
-  set_sizetype
-    (TREE_TYPE (IDENTIFIER_GLOBAL_VALUE (get_identifier (SIZE_TYPE))));
-  ffecom_typesize_pointer_
-    = TREE_INT_CST_LOW (TYPE_SIZE (sizetype)) / BITS_PER_UNIT;
-
-  build_common_tree_nodes_2 (0);
-
-  /* Define both `signed char' and `unsigned char'.  */
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("signed char"),
-			signed_char_type_node));
-
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned char"),
-			unsigned_char_type_node));
-
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("float"),
-			float_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("double"),
-			double_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("long double"),
-			long_double_type_node));
-
-  /* For now, override what build_common_tree_nodes has done.  */
-  complex_integer_type_node = ffecom_make_complex_type_ (integer_type_node);
-  complex_float_type_node = ffecom_make_complex_type_ (float_type_node);
-  complex_double_type_node = ffecom_make_complex_type_ (double_type_node);
-  complex_long_double_type_node
-    = ffecom_make_complex_type_ (long_double_type_node);
-
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex int"),
-			complex_integer_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex float"),
-			complex_float_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex double"),
-			complex_double_type_node));
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex long double"),
-			complex_long_double_type_node));
-
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("void"),
-			void_type_node));
-  /* We are not going to have real types in C with less than byte alignment,
-     so we might as well not have any types that claim to have it.  */
-  TYPE_ALIGN (void_type_node) = BITS_PER_UNIT;
-  TYPE_USER_ALIGN (void_type_node) = 0;
-
-  string_type_node = build_pointer_type (char_type_node);
-
-  ffecom_tree_fun_type_void
-    = build_function_type (void_type_node, NULL_TREE);
-
-  ffecom_tree_ptr_to_fun_type_void
-    = build_pointer_type (ffecom_tree_fun_type_void);
-
-  endlink = tree_cons (NULL_TREE, void_type_node, NULL_TREE);
-
-  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);
-
-  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);
-
-  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)
-      {
-	ffecom_tree_type[i][j] = NULL_TREE;
-	ffecom_tree_fun_type[i][j] = NULL_TREE;
-	ffecom_tree_ptr_to_fun_type[i][j] = NULL_TREE;
-	ffecom_f2c_typecode_[i][j] = -1;
-      }
-
-  /* Set up standard g77 types.  Note that INTEGER and LOGICAL are set
-     to size FLOAT_TYPE_SIZE because they have to be the same size as
-     REAL, which also is FLOAT_TYPE_SIZE, according to the standard.
-     Compiler options and other such stuff that change the ways these
-     types are set should not affect this particular setup.  */
-
-  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1]
-    = t = make_signed_type (FLOAT_TYPE_SIZE);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("integer"),
-			t));
-  type = ffetype_new ();
-  base_type = type;
-  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER1,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 1, type);
-  ffecom_typesize_integer1_ = ffetype_size (type);
-  assert (ffetype_size (type) == sizeof (ffetargetInteger1));
-
-  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER1]
-    = t = make_unsigned_type (FLOAT_TYPE_SIZE);	/* HOLLERITH means unsigned. */
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned"),
-			t));
-
-  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER2]
-    = t = make_signed_type (CHAR_TYPE_SIZE);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("byte"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER2,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 3, type);
-  assert (ffetype_size (type) == sizeof (ffetargetInteger2));
-
-  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER2]
-    = t = make_unsigned_type (CHAR_TYPE_SIZE);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned byte"),
-			t));
-
-  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER3]
-    = t = make_signed_type (CHAR_TYPE_SIZE * 2);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("word"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER3,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 6, type);
-  assert (ffetype_size (type) == sizeof (ffetargetInteger3));
-
-  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER3]
-    = t = make_unsigned_type (CHAR_TYPE_SIZE * 2);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned word"),
-			t));
-
-  ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER4]
-    = t = make_signed_type (FLOAT_TYPE_SIZE * 2);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("integer4"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGER4,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 2, type);
-  assert (ffetype_size (type) == sizeof (ffetargetInteger4));
-
-  ffecom_tree_type[FFEINFO_basictypeHOLLERITH][FFEINFO_kindtypeINTEGER4]
-    = t = make_unsigned_type (FLOAT_TYPE_SIZE * 2);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("unsigned4"),
-			t));
-
-#if 0
-  if (ffe_is_do_internal_checks ()
-      && LONG_TYPE_SIZE != FLOAT_TYPE_SIZE
-      && LONG_TYPE_SIZE != CHAR_TYPE_SIZE
-      && LONG_TYPE_SIZE != SHORT_TYPE_SIZE
-      && LONG_TYPE_SIZE != LONG_LONG_TYPE_SIZE)
-    {
-      fprintf (stderr, "Sorry, no g77 support for LONG_TYPE_SIZE (%d bits) yet.\n",
-	       LONG_TYPE_SIZE);
-    }
-#endif
-
-  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL1]
-    = t = make_signed_type (FLOAT_TYPE_SIZE);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical"),
-			t));
-  type = ffetype_new ();
-  base_type = type;
-  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL1,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 1, type);
-  assert (ffetype_size (type) == sizeof (ffetargetLogical1));
-
-  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL2]
-    = t = make_signed_type (CHAR_TYPE_SIZE);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical2"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL2,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 3, type);
-  assert (ffetype_size (type) == sizeof (ffetargetLogical2));
-
-  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL3]
-    = t = make_signed_type (CHAR_TYPE_SIZE * 2);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical3"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL3,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 6, type);
-  assert (ffetype_size (type) == sizeof (ffetargetLogical3));
-
-  ffecom_tree_type[FFEINFO_basictypeLOGICAL][FFEINFO_kindtypeLOGICAL4]
-    = t = make_signed_type (FLOAT_TYPE_SIZE * 2);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("logical4"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICAL4,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 2, type);
-  assert (ffetype_size (type) == sizeof (ffetargetLogical4));
-
-  ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]
-    = t = make_node (REAL_TYPE);
-  TYPE_PRECISION (t) = FLOAT_TYPE_SIZE;
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("real"),
-			t));
-  layout_type (t);
-  type = ffetype_new ();
-  base_type = type;
-  ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREAL1,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 1, type);
-  ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]
-    = FFETARGET_f2cTYREAL;
-  assert (ffetype_size (type) == sizeof (ffetargetReal1));
-
-  ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREALDOUBLE]
-    = t = make_node (REAL_TYPE);
-  TYPE_PRECISION (t) = FLOAT_TYPE_SIZE * 2;	/* Always twice REAL. */
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("double precision"),
-			t));
-  layout_type (t);
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 2, type);
-  ffecom_f2c_typecode_[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]
-    = FFETARGET_f2cTYDREAL;
-  assert (ffetype_size (type) == sizeof (ffetargetReal2));
-
-  ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1]
-    = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL1]);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("complex"),
-			t));
-  type = ffetype_new ();
-  base_type = type;
-  ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREAL1,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 1, type);
-  ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL1]
-    = FFETARGET_f2cTYCOMPLEX;
-  assert (ffetype_size (type) == sizeof (ffetargetComplex1));
-
-  ffecom_tree_type[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREALDOUBLE]
-    = t = ffecom_make_complex_type_ (ffecom_tree_type[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2]);
-  pushdecl (build_decl (TYPE_DECL, get_identifier ("double complex"),
-			t));
-  type = ffetype_new ();
-  ffeinfo_set_type (FFEINFO_basictypeCOMPLEX, FFEINFO_kindtypeREALDOUBLE,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_star (base_type,
-		    TREE_INT_CST_LOW (TYPE_SIZE (t)) / CHAR_TYPE_SIZE,
-		    type);
-  ffetype_set_kind (base_type, 2,
-		    type);
-  ffecom_f2c_typecode_[FFEINFO_basictypeCOMPLEX][FFEINFO_kindtypeREAL2]
-    = FFETARGET_f2cTYDCOMPLEX;
-  assert (ffetype_size (type) == sizeof (ffetargetComplex2));
-
-  /* Make function and ptr-to-function types for non-CHARACTER types. */
-
-  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)
-      {
-	if ((t = ffecom_tree_type[i][j]) != NULL_TREE)
-	  {
-	    if (i == FFEINFO_basictypeINTEGER)
-	      {
-		/* Figure out the smallest INTEGER type that can hold
-		   a pointer on this machine. */
-		if (GET_MODE_SIZE (TYPE_MODE (t))
-		    >= GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
-		  {
-		    if ((ffecom_pointer_kind_ == FFEINFO_kindtypeNONE)
-			|| (GET_MODE_SIZE (TYPE_MODE (ffecom_tree_type[i][ffecom_pointer_kind_]))
-			    > GET_MODE_SIZE (TYPE_MODE (t))))
-		      ffecom_pointer_kind_ = j;
-		  }
-	      }
-	    else if (i == FFEINFO_basictypeCOMPLEX)
-	      t = void_type_node;
-	    /* For f2c compatibility, REAL functions are really
-	       implemented as DOUBLE PRECISION.  */
-	    else if ((i == FFEINFO_basictypeREAL)
-		     && (j == FFEINFO_kindtypeREAL1))
-	      t = ffecom_tree_type
-		[FFEINFO_basictypeREAL][FFEINFO_kindtypeREAL2];
-
-	    t = ffecom_tree_fun_type[i][j] = build_function_type (t,
-								  NULL_TREE);
-	    ffecom_tree_ptr_to_fun_type[i][j] = build_pointer_type (t);
-	  }
-      }
-
-  /* Set up pointer types.  */
-
-  if (ffecom_pointer_kind_ == FFEINFO_basictypeNONE)
-    fatal_error ("no INTEGER type can hold a pointer on this configuration");
-  else if (0 && ffe_is_do_internal_checks ())
-    fprintf (stderr, "Pointer type kt=%d\n", ffecom_pointer_kind_);
-  ffetype_set_kind (ffeinfo_type (FFEINFO_basictypeINTEGER,
-				  FFEINFO_kindtypeINTEGERDEFAULT),
-		    7,
-		    ffeinfo_type (FFEINFO_basictypeINTEGER,
-				  ffecom_pointer_kind_));
-
-  if (ffe_is_ugly_assign ())
-    ffecom_label_kind_ = ffecom_pointer_kind_;	/* Require ASSIGN etc to this. */
-  else
-    ffecom_label_kind_ = FFEINFO_kindtypeINTEGERDEFAULT;
-  if (0 && ffe_is_do_internal_checks ())
-    fprintf (stderr, "Label type kt=%d\n", ffecom_label_kind_);
-
-  ffecom_integer_type_node
-    = ffecom_tree_type[FFEINFO_basictypeINTEGER][FFEINFO_kindtypeINTEGER1];
-  ffecom_integer_zero_node = convert (ffecom_integer_type_node,
-				      integer_zero_node);
-  ffecom_integer_one_node = convert (ffecom_integer_type_node,
-				     integer_one_node);
-
-  /* Yes, the "FLOAT_TYPE_SIZE" references below are intentional.
-     Turns out that by TYLONG, runtime/libI77/lio.h really means
-     "whatever size an ftnint is".  For consistency and sanity,
-     com.h and runtime/f2c.h.in agree that flag, ftnint, and ftlen
-     all are INTEGER, which we also make out of whatever back-end
-     integer type is FLOAT_TYPE_SIZE bits wide.  This change, from
-     LONG_TYPE_SIZE, for TYLONG and TYLOGICAL, was necessary to
-     accommodate machines like the Alpha.  Note that this suggests
-     f2c and libf2c are missing a distinction perhaps needed on
-     some machines between "int" and "long int".  -- burley 0.5.5 950215 */
-
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, FLOAT_TYPE_SIZE,
-			    FFETARGET_f2cTYLONG);
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, SHORT_TYPE_SIZE,
-			    FFETARGET_f2cTYSHORT);
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, CHAR_TYPE_SIZE,
-			    FFETARGET_f2cTYINT1);
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeINTEGER, LONG_LONG_TYPE_SIZE,
-			    FFETARGET_f2cTYQUAD);
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, FLOAT_TYPE_SIZE,
-			    FFETARGET_f2cTYLOGICAL);
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, SHORT_TYPE_SIZE,
-			    FFETARGET_f2cTYLOGICAL2);
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, CHAR_TYPE_SIZE,
-			    FFETARGET_f2cTYLOGICAL1);
-  /* ~~~Not really such a type in libf2c, e.g. I/O support?  */
-  ffecom_f2c_set_lio_code_ (FFEINFO_basictypeLOGICAL, LONG_LONG_TYPE_SIZE,
-			    FFETARGET_f2cTYQUAD);
-
-  /* CHARACTER stuff is all special-cased, so it is not handled in the above
-     loop.  CHARACTER items are built as arrays of unsigned char.  */
-
-  ffecom_tree_type[FFEINFO_basictypeCHARACTER]
-    [FFEINFO_kindtypeCHARACTER1] = t = char_type_node;
-  type = ffetype_new ();
-  base_type = type;
-  ffeinfo_set_type (FFEINFO_basictypeCHARACTER,
-		    FFEINFO_kindtypeCHARACTER1,
-		    type);
-  ffetype_set_ams (type,
-		   TYPE_ALIGN (t) / BITS_PER_UNIT, 0,
-		   TREE_INT_CST_LOW (TYPE_SIZE (t)) / BITS_PER_UNIT);
-  ffetype_set_kind (base_type, 1, type);
-  assert (ffetype_size (type)
-	  == sizeof (((ffetargetCharacter1) { 0, NULL }).text[0]));
-
-  ffecom_tree_fun_type[FFEINFO_basictypeCHARACTER]
-    [FFEINFO_kindtypeCHARACTER1] = ffecom_tree_fun_type_void;
-  ffecom_tree_ptr_to_fun_type[FFEINFO_basictypeCHARACTER]
-    [FFEINFO_kindtypeCHARACTER1]
-    = ffecom_tree_ptr_to_fun_type_void;
-  ffecom_f2c_typecode_[FFEINFO_basictypeCHARACTER][FFEINFO_kindtypeCHARACTER1]
-    = FFETARGET_f2cTYCHAR;
-
-  ffecom_f2c_typecode_[FFEINFO_basictypeANY][FFEINFO_kindtypeANY]
-    = 0;
-
-  /* Make multi-return-value type and fields. */
-
-  ffecom_multi_type_node_ = make_node (UNION_TYPE);
-
-  field = NULL_TREE;
-
-  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)
-      {
-	char name[30];
-
-	if (ffecom_tree_type[i][j] == NULL_TREE)
-	  continue;		/* Not supported. */
-	sprintf (&name[0], "bt_%s_kt_%s",
-		 ffeinfo_basictype_string ((ffeinfoBasictype) i),
-		 ffeinfo_kindtype_string ((ffeinfoKindtype) j));
-	ffecom_multi_fields_[i][j] = build_decl (FIELD_DECL,
-						 get_identifier (name),
-						 ffecom_tree_type[i][j]);
-	DECL_CONTEXT (ffecom_multi_fields_[i][j])
-	  = ffecom_multi_type_node_;
-	DECL_ALIGN (ffecom_multi_fields_[i][j]) = 0;
-	DECL_USER_ALIGN (ffecom_multi_fields_[i][j]) = 0;
-	TREE_CHAIN (ffecom_multi_fields_[i][j]) = field;
-	field = ffecom_multi_fields_[i][j];
-      }
-
-  TYPE_FIELDS (ffecom_multi_type_node_) = field;
-  layout_type (ffecom_multi_type_node_);
-
-  /* Subroutines usually return integer because they might have alternate
-     returns. */
-
-  ffecom_tree_subr_type
-    = build_function_type (integer_type_node, NULL_TREE);
-  ffecom_tree_ptr_to_subr_type
-    = build_pointer_type (ffecom_tree_subr_type);
-  ffecom_tree_blockdata_type
-    = build_function_type (void_type_node, 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,
-		    BUILT_IN_COS, BUILT_IN_NORMAL, "cos", NULL_TREE);
-  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,
-			 FFECOM_f2cINTEGER,
-			 "integer");
-  ffecom_f2c_make_type_ (&ffecom_f2c_address_type_node,
-			 FFECOM_f2cADDRESS,
-			 "address");
-  ffecom_f2c_make_type_ (&ffecom_f2c_real_type_node,
-			 FFECOM_f2cREAL,
-			 "real");
-  ffecom_f2c_make_type_ (&ffecom_f2c_doublereal_type_node,
-			 FFECOM_f2cDOUBLEREAL,
-			 "doublereal");
-  ffecom_f2c_make_type_ (&ffecom_f2c_complex_type_node,
-			 FFECOM_f2cCOMPLEX,
-			 "complex");
-  ffecom_f2c_make_type_ (&ffecom_f2c_doublecomplex_type_node,
-			 FFECOM_f2cDOUBLECOMPLEX,
-			 "doublecomplex");
-  ffecom_f2c_make_type_ (&ffecom_f2c_longint_type_node,
-			 FFECOM_f2cLONGINT,
-			 "longint");
-  ffecom_f2c_make_type_ (&ffecom_f2c_logical_type_node,
-			 FFECOM_f2cLOGICAL,
-			 "logical");
-  ffecom_f2c_make_type_ (&ffecom_f2c_flag_type_node,
-			 FFECOM_f2cFLAG,
-			 "flag");
-  ffecom_f2c_make_type_ (&ffecom_f2c_ftnlen_type_node,
-			 FFECOM_f2cFTNLEN,
-			 "ftnlen");
-  ffecom_f2c_make_type_ (&ffecom_f2c_ftnint_type_node,
-			 FFECOM_f2cFTNINT,
-			 "ftnint");
-
-  ffecom_f2c_ftnlen_zero_node
-    = convert (ffecom_f2c_ftnlen_type_node, integer_zero_node);
-
-  ffecom_f2c_ftnlen_one_node
-    = convert (ffecom_f2c_ftnlen_type_node, integer_one_node);
-
-  ffecom_f2c_ftnlen_two_node = build_int_2 (2, 0);
-  TREE_TYPE (ffecom_f2c_ftnlen_two_node) = ffecom_integer_type_node;
-
-  ffecom_f2c_ptr_to_ftnlen_type_node
-    = build_pointer_type (ffecom_f2c_ftnlen_type_node);
-
-  ffecom_f2c_ptr_to_ftnint_type_node
-    = build_pointer_type (ffecom_f2c_ftnint_type_node);
-
-  ffecom_f2c_ptr_to_integer_type_node
-    = build_pointer_type (ffecom_f2c_integer_type_node);
-
-  ffecom_f2c_ptr_to_real_type_node
-    = build_pointer_type (ffecom_f2c_real_type_node);
-
-  ffecom_float_zero_ = build_real (float_type_node, dconst0);
-  ffecom_double_zero_ = build_real (double_type_node, dconst0);
-  ffecom_float_half_ = build_real (float_type_node, dconsthalf);
-  ffecom_double_half_ = build_real (double_type_node, dconsthalf);
-
-  /* Do "extern int xargc;".  */
-
-  ffecom_tree_xargc_ = build_decl (VAR_DECL,
-				   get_identifier ("f__xargc"),
-				   integer_type_node);
-  DECL_EXTERNAL (ffecom_tree_xargc_) = 1;
-  TREE_STATIC (ffecom_tree_xargc_) = 1;
-  TREE_PUBLIC (ffecom_tree_xargc_) = 1;
-  ffecom_tree_xargc_ = start_decl (ffecom_tree_xargc_, FALSE);
-  finish_decl (ffecom_tree_xargc_, NULL_TREE, FALSE);
-
-#if 0	/* This is being fixed, and seems to be working now. */
-  if ((FLOAT_TYPE_SIZE != 32)
-      || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))) != 32))
-    {
-      warning ("configuration: REAL, INTEGER, and LOGICAL are %d bits wide,",
-	       (int) FLOAT_TYPE_SIZE);
-      warning ("and pointers are %d bits wide, but g77 doesn't yet work",
-	  (int) TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (null_pointer_node))));
-      warning ("properly unless they all are 32 bits wide");
-      warning ("Please keep this in mind before you report bugs.");
-    }
-#endif
-
-#if 0	/* Code in ste.c that would crash has been commented out. */
-  if (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
-      < TYPE_PRECISION (string_type_node))
-    /* I/O will probably crash.  */
-    warning ("configuration: char * holds %d bits, but ftnlen only %d",
-	     TYPE_PRECISION (string_type_node),
-	     TYPE_PRECISION (ffecom_f2c_ftnlen_type_node));
-#endif
-
-#if 0	/* ASSIGN-related stuff has been changed to accommodate this. */
-  if (TYPE_PRECISION (ffecom_integer_type_node)
-      < TYPE_PRECISION (string_type_node))
-    /* ASSIGN 10 TO I will crash.  */
-    warning ("configuration: char * holds %d bits, but INTEGER only %d --\n\
- ASSIGN statement might fail",
-	     TYPE_PRECISION (string_type_node),
-	     TYPE_PRECISION (ffecom_integer_type_node));
-#endif
-}
-
-/* ffecom_init_2 -- Initialize
-
-   ffecom_init_2();  */
-
-void
-ffecom_init_2 (void)
-{
-  assert (ffecom_outer_function_decl_ == NULL_TREE);
-  assert (current_function_decl == NULL_TREE);
-  assert (ffecom_which_entrypoint_decl_ == NULL_TREE);
-
-  ffecom_master_arglist_ = NULL;
-  ++ffecom_num_fns_;
-  ffecom_primary_entry_ = NULL;
-  ffecom_is_altreturning_ = FALSE;
-  ffecom_func_result_ = NULL_TREE;
-  ffecom_multi_retval_ = NULL_TREE;
-}
-
-/* ffecom_list_expr -- Transform list of exprs into gcc tree
-
-   tree t;
-   ffebld expr;	 // FFE opITEM list.
-   tree = ffecom_list_expr(expr);
-
-   List of actual args is transformed into corresponding gcc backend list.  */
-
-tree
-ffecom_list_expr (ffebld expr)
-{
-  tree list;
-  tree *plist = &list;
-  tree trail = NULL_TREE;	/* Append char length args here. */
-  tree *ptrail = &trail;
-  tree length;
-
-  while (expr != NULL)
-    {
-      tree texpr = ffecom_arg_expr (ffebld_head (expr), &length);
-
-      if (texpr == error_mark_node)
-	return error_mark_node;
-
-      *plist = build_tree_list (NULL_TREE, texpr);
-      plist = &TREE_CHAIN (*plist);
-      expr = ffebld_trail (expr);
-      if (length != NULL_TREE)
-	{
-	  *ptrail = build_tree_list (NULL_TREE, length);
-	  ptrail = &TREE_CHAIN (*ptrail);
-	}
-    }
-
-  *plist = trail;
-
-  return list;
-}
-
-/* ffecom_list_ptr_to_expr -- Transform list of exprs into gcc tree
-
-   tree t;
-   ffebld expr;	 // FFE opITEM list.
-   tree = ffecom_list_ptr_to_expr(expr);
-
-   List of actual args is transformed into corresponding gcc backend list for
-   use in calling an external procedure (vs. a statement function).  */
-
-tree
-ffecom_list_ptr_to_expr (ffebld expr)
-{
-  tree list;
-  tree *plist = &list;
-  tree trail = NULL_TREE;	/* Append char length args here. */
-  tree *ptrail = &trail;
-  tree length;
-
-  while (expr != NULL)
-    {
-      tree texpr = ffecom_arg_ptr_to_expr (ffebld_head (expr), &length);
-
-      if (texpr == error_mark_node)
-	return error_mark_node;
-
-      *plist = build_tree_list (NULL_TREE, texpr);
-      plist = &TREE_CHAIN (*plist);
-      expr = ffebld_trail (expr);
-      if (length != NULL_TREE)
-	{
-	  *ptrail = build_tree_list (NULL_TREE, length);
-	  ptrail = &TREE_CHAIN (*ptrail);
-	}
-    }
-
-  *plist = trail;
-
-  return list;
-}
-
-/* Obtain gcc's LABEL_DECL tree for label.  */
-
-tree
-ffecom_lookup_label (ffelab label)
-{
-  tree glabel;
-
-  if (ffelab_hook (label) == NULL_TREE)
-    {
-      char labelname[16];
-
-      switch (ffelab_type (label))
-	{
-	case FFELAB_typeLOOPEND:
-	case FFELAB_typeNOTLOOP:
-	case FFELAB_typeENDIF:
-	  sprintf (labelname, "%" ffelabValue_f "u", ffelab_value (label));
-	  glabel = build_decl (LABEL_DECL, get_identifier (labelname),
-			       void_type_node);
-	  DECL_CONTEXT (glabel) = current_function_decl;
-	  DECL_MODE (glabel) = VOIDmode;
-	  break;
-
-	case FFELAB_typeFORMAT:
-	  glabel = build_decl (VAR_DECL,
-			       ffecom_get_invented_identifier
-			       ("__g77_format_%d", (int) ffelab_value (label)),
-			       build_type_variant (build_array_type
-						   (char_type_node,
-						    NULL_TREE),
-						   1, 0));
-	  TREE_CONSTANT (glabel) = 1;
-	  TREE_STATIC (glabel) = 1;
-	  DECL_CONTEXT (glabel) = current_function_decl;
-	  DECL_INITIAL (glabel) = NULL;
-	  make_decl_rtl (glabel, NULL);
-	  expand_decl (glabel);
-
-	  ffecom_save_tree_forever (glabel);
-
-	  break;
-
-	case FFELAB_typeANY:
-	  glabel = error_mark_node;
-	  break;
-
-	default:
-	  assert ("bad label type" == NULL);
-	  glabel = NULL;
-	  break;
-	}
-      ffelab_set_hook (label, glabel);
-    }
-  else
-    {
-      glabel = ffelab_hook (label);
-    }
-
-  return glabel;
-}
-
-/* Stabilizes the arguments.  Don't use this if the lhs and rhs come from
-   a single source specification (as in the fourth argument of MVBITS).
-   If the type is NULL_TREE, the type of lhs is used to make the type of
-   the MODIFY_EXPR.  */
-
-tree
-ffecom_modify (tree newtype, tree lhs, tree rhs)
-{
-  if (lhs == error_mark_node || rhs == error_mark_node)
-    return error_mark_node;
-
-  if (newtype == NULL_TREE)
-    newtype = TREE_TYPE (lhs);
-
-  if (TREE_SIDE_EFFECTS (lhs))
-    lhs = stabilize_reference (lhs);
-
-  return ffecom_2s (MODIFY_EXPR, newtype, lhs, rhs);
-}
-
-/* Register source file name.  */
-
-void
-ffecom_file (const char *name)
-{
-  ffecom_file_ (name);
-}
-
-/* ffecom_notify_init_storage -- An aggregate storage is now fully init'ed
-
-   ffestorag st;
-   ffecom_notify_init_storage(st);
-
-   Gets called when all possible units in an aggregate storage area (a LOCAL
-   with equivalences or a COMMON) have been initialized.  The initialization
-   info either is in ffestorag_init or, if that is NULL,
-   ffestorag_accretion:
-
-   ffestorag_init may contain an opCONTER or opARRTER.	opCONTER may occur
-   even for an array if the array is one element in length!
-
-   ffestorag_accretion will contain an opACCTER.  It is much like an
-   opARRTER except it has an ffebit object in it instead of just a size.
-   The back end can use the info in the ffebit object, if it wants, to
-   reduce the amount of actual initialization, but in any case it should
-   kill the ffebit object when done.  Also, set accretion to NULL but
-   init to a non-NULL value.
-
-   After performing initialization, DO NOT set init to NULL, because that'll
-   tell the front end it is ok for more initialization to happen.  Instead,
-   set init to an opANY expression or some such thing that you can use to
-   tell that you've already initialized the object.
-
-   27-Oct-91  JCB  1.1
-      Support two-pass FFE.  */
-
-void
-ffecom_notify_init_storage (ffestorag st)
-{
-  ffebld init;			/* The initialization expression. */
-
-  if (ffestorag_init (st) == NULL)
-    {
-      init = ffestorag_accretion (st);
-      assert (init != NULL);
-      ffestorag_set_accretion (st, NULL);
-      ffestorag_set_accretes (st, 0);
-      ffestorag_set_init (st, init);
-    }
-}
-
-/* ffecom_notify_init_symbol -- A symbol is now fully init'ed
-
-   ffesymbol s;
-   ffecom_notify_init_symbol(s);
-
-   Gets called when all possible units in a symbol (not placed in COMMON
-   or involved in EQUIVALENCE, unless it as yet has no ffestorag object)
-   have been initialized.  The initialization info either is in
-   ffesymbol_init or, if that is NULL, ffesymbol_accretion:
-
-   ffesymbol_init may contain an opCONTER or opARRTER.	opCONTER may occur
-   even for an array if the array is one element in length!
-
-   ffesymbol_accretion will contain an opACCTER.  It is much like an
-   opARRTER except it has an ffebit object in it instead of just a size.
-   The back end can use the info in the ffebit object, if it wants, to
-   reduce the amount of actual initialization, but in any case it should
-   kill the ffebit object when done.  Also, set accretion to NULL but
-   init to a non-NULL value.
-
-   After performing initialization, DO NOT set init to NULL, because that'll
-   tell the front end it is ok for more initialization to happen.  Instead,
-   set init to an opANY expression or some such thing that you can use to
-   tell that you've already initialized the object.
-
-   27-Oct-91  JCB  1.1
-      Support two-pass FFE.  */
-
-void
-ffecom_notify_init_symbol (ffesymbol s)
-{
-  ffebld init;			/* The initialization expression. */
-
-  if (ffesymbol_storage (s) == NULL)
-    return;			/* Do nothing until COMMON/EQUIVALENCE
-				   possibilities checked. */
-
-  if ((ffesymbol_init (s) == NULL)
-      && ((init = ffesymbol_accretion (s)) != NULL))
-    {
-      ffesymbol_set_accretion (s, NULL);
-      ffesymbol_set_accretes (s, 0);
-      ffesymbol_set_init (s, init);
-    }
-}
-
-/* ffecom_notify_primary_entry -- Learn which is the primary entry point
-
-   ffesymbol s;
-   ffecom_notify_primary_entry(s);
-
-   Gets called when implicit or explicit PROGRAM statement seen or when
-   FUNCTION, SUBROUTINE, or BLOCK DATA statement seen, with the primary
-   global symbol that serves as the entry point.  */
-
-void
-ffecom_notify_primary_entry (ffesymbol s)
-{
-  ffecom_primary_entry_ = s;
-  ffecom_primary_entry_kind_ = ffesymbol_kind (s);
-
-  if ((ffecom_primary_entry_kind_ == FFEINFO_kindFUNCTION)
-      || (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE))
-    ffecom_primary_entry_is_proc_ = TRUE;
-  else
-    ffecom_primary_entry_is_proc_ = FALSE;
-
-  if (!ffe_is_silent ())
-    {
-      if (ffecom_primary_entry_kind_ == FFEINFO_kindPROGRAM)
-	fprintf (stderr, "%s:\n", ffesymbol_text (s));
-      else
-	fprintf (stderr, "  %s:\n", ffesymbol_text (s));
-    }
-
-  if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE)
-    {
-      ffebld list;
-      ffebld arg;
-
-      for (list = ffesymbol_dummyargs (s);
-	   list != NULL;
-	   list = ffebld_trail (list))
-	{
-	  arg = ffebld_head (list);
-	  if (ffebld_op (arg) == FFEBLD_opSTAR)
-	    {
-	      ffecom_is_altreturning_ = TRUE;
-	      break;
-	    }
-	}
-    }
-}
-
-FILE *
-ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c)
-{
-  return ffecom_open_include_ (name, l, c);
-}
-
-/* ffecom_ptr_to_expr -- Transform expr into gcc tree with & in front
-
-   tree t;
-   ffebld expr;	 // FFE expression.
-   tree = ffecom_ptr_to_expr(expr);
-
-   Like ffecom_expr, but sticks address-of in front of most things.  */
-
-tree
-ffecom_ptr_to_expr (ffebld expr)
-{
-  tree item;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffesymbol s;
-
-  assert (expr != NULL);
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opSYMTER:
-      s = ffebld_symter (expr);
-      if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
-	{
-	  ffecomGfrt ix;
-
-	  ix = ffeintrin_gfrt_indirect (ffebld_symter_implementation (expr));
-	  assert (ix != FFECOM_gfrt);
-	  if ((item = ffecom_gfrt_[ix]) == NULL_TREE)
-	    {
-	      ffecom_make_gfrt_ (ix);
-	      item = ffecom_gfrt_[ix];
-	    }
-	}
-      else
-	{
-	  item = ffesymbol_hook (s).decl_tree;
-	  if (item == NULL_TREE)
-	    {
-	      s = ffecom_sym_transform_ (s);
-	      item = ffesymbol_hook (s).decl_tree;
-	    }
-	}
-      assert (item != NULL);
-      if (item == error_mark_node)
-	return item;
-      if (!ffesymbol_hook (s).addr)
-	item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
-			 item);
-      return item;
-
-    case FFEBLD_opARRAYREF:
-      return ffecom_arrayref_ (NULL_TREE, expr, 1);
-
-    case FFEBLD_opCONTER:
-
-      bt = ffeinfo_basictype (ffebld_info (expr));
-      kt = ffeinfo_kindtype (ffebld_info (expr));
-
-      item = ffecom_constantunion (&ffebld_constant_union
-				   (ffebld_conter (expr)), bt, kt,
-				   ffecom_tree_type[bt][kt]);
-      if (item == error_mark_node)
-	return error_mark_node;
-      item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
-		       item);
-      return item;
-
-    case FFEBLD_opANY:
-      return error_mark_node;
-
-    default:
-      bt = ffeinfo_basictype (ffebld_info (expr));
-      kt = ffeinfo_kindtype (ffebld_info (expr));
-
-      item = ffecom_expr (expr);
-      if (item == error_mark_node)
-	return error_mark_node;
-
-      /* The back end currently optimizes a bit too zealously for us, in that
-	 we fail JCB001 if the following block of code is omitted.  It checks
-	 to see if the transformed expression is a symbol or array reference,
-	 and encloses it in a SAVE_EXPR if that is the case.  */
-
-      STRIP_NOPS (item);
-      if ((TREE_CODE (item) == VAR_DECL)
-	  || (TREE_CODE (item) == PARM_DECL)
-	  || (TREE_CODE (item) == RESULT_DECL)
-	  || (TREE_CODE (item) == INDIRECT_REF)
-	  || (TREE_CODE (item) == ARRAY_REF)
-	  || (TREE_CODE (item) == COMPONENT_REF)
-#ifdef OFFSET_REF
-	  || (TREE_CODE (item) == OFFSET_REF)
-#endif
-	  || (TREE_CODE (item) == BUFFER_REF)
-	  || (TREE_CODE (item) == REALPART_EXPR)
-	  || (TREE_CODE (item) == IMAGPART_EXPR))
-	{
-	  item = ffecom_save_tree (item);
-	}
-
-      item = ffecom_1 (ADDR_EXPR, build_pointer_type (TREE_TYPE (item)),
-		       item);
-      return item;
-    }
-
-  assert ("fall-through error" == NULL);
-  return error_mark_node;
-}
-
-/* Obtain a temp var with given data type.
-
-   size is FFETARGET_charactersizeNONE for a non-CHARACTER type
-   or >= 0 for a CHARACTER type.
-
-   elements is -1 for a scalar or > 0 for an array of type.  */
-
-tree
-ffecom_make_tempvar (const char *commentary, tree type,
-		     ffetargetCharacterSize size, int elements)
-{
-  tree t;
-  static int mynumber;
-
-  assert (current_binding_level->prep_state < 2);
-
-  if (type == error_mark_node)
-    return error_mark_node;
-
-  if (size != FFETARGET_charactersizeNONE)
-    type = build_array_type (type,
-			     build_range_type (ffecom_f2c_ftnlen_type_node,
-					       ffecom_f2c_ftnlen_one_node,
-					       build_int_2 (size, 0)));
-  if (elements != -1)
-    type = build_array_type (type,
-			     build_range_type (integer_type_node,
-					       integer_zero_node,
-					       build_int_2 (elements - 1,
-							    0)));
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_%s_%d",
-						  commentary,
-						  mynumber++),
-		  type);
-
-  t = start_decl (t, FALSE);
-  finish_decl (t, NULL_TREE, FALSE);
-
-  return t;
-}
-
-/* Prepare argument pointer to expression.
-
-   Like ffecom_prepare_expr, except for expressions to be evaluated
-   via ffecom_arg_ptr_to_expr.  */
-
-void
-ffecom_prepare_arg_ptr_to_expr (ffebld expr)
-{
-  /* ~~For now, it seems to be the same thing.  */
-  ffecom_prepare_expr (expr);
-  return;
-}
-
-/* End of preparations.  */
-
-bool
-ffecom_prepare_end (void)
-{
-  int prep_state = current_binding_level->prep_state;
-
-  assert (prep_state < 2);
-  current_binding_level->prep_state = 2;
-
-  return (prep_state == 1) ? TRUE : FALSE;
-}
-
-/* Prepare expression.
-
-   This is called before any code is generated for the current block.
-   It scans the expression, declares any temporaries that might be needed
-   during evaluation of the expression, and stores those temporaries in
-   the appropriate "hook" fields of the expression.  `dest', if not NULL,
-   specifies the destination that ffecom_expr_ will see, in case that
-   helps avoid generating unused temporaries.
-
-   ~~Improve to avoid allocating unused temporaries by taking `dest'
-   into account vis-a-vis aliasing requirements of complex/character
-   functions.  */
-
-void
-ffecom_prepare_expr_ (ffebld expr, ffebld dest UNUSED)
-{
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize sz;
-  tree tempvar = NULL_TREE;
-
-  assert (current_binding_level->prep_state < 2);
-
-  if (! expr)
-    return;
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-  sz = ffeinfo_size (ffebld_info (expr));
-
-  /* Generate whatever temporaries are needed to represent the result
-     of the expression.  */
-
-  if (bt == FFEINFO_basictypeCHARACTER)
-    {
-      while (ffebld_op (expr) == FFEBLD_opPAREN)
-	expr = ffebld_left (expr);
-    }
-
-  switch (ffebld_op (expr))
-    {
-    default:
-      /* Don't make temps for SYMTER, CONTER, etc.  */
-      if (ffebld_arity (expr) == 0)
-	break;
-
-      switch (bt)
-	{
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffebld_op (expr) == FFEBLD_opFUNCREF)
-	    {
-	      ffesymbol s;
-
-	      if (ffebld_op (ffebld_left (expr)) != FFEBLD_opSYMTER)
-		break;
-
-	      s = ffebld_symter (ffebld_left (expr));
-	      if (ffesymbol_where (s) == FFEINFO_whereCONSTANT
-		  || (ffesymbol_where (s) != FFEINFO_whereINTRINSIC
-		      && ! ffesymbol_is_f2c (s))
-		  || (ffesymbol_where (s) == FFEINFO_whereINTRINSIC
-		      && ! ffe_is_f2c_library ()))
-		break;
-	    }
-	  else if (ffebld_op (expr) == FFEBLD_opPOWER)
-	    {
-	      /* Requires special treatment.  There's no POW_CC function
-		 in libg2c, so POW_ZZ is used, which means we always
-		 need a double-complex temp, not a single-complex.  */
-	      kt = FFEINFO_kindtypeREAL2;
-	    }
-	  else if (ffebld_op (expr) != FFEBLD_opDIVIDE)
-	    /* The other ops don't need temps for complex operands.  */
-	    break;
-
-	  /* ~~~Avoid making temps for some intrinsics, such as AIMAG(C),
-	     REAL(C).  See 19990325-0.f, routine `check', for cases.  */
-	  tempvar = ffecom_make_tempvar ("complex",
-					 ffecom_tree_type
-					 [FFEINFO_basictypeCOMPLEX][kt],
-					 FFETARGET_charactersizeNONE,
-					 -1);
-	  break;
-
-	case FFEINFO_basictypeCHARACTER:
-	  if (ffebld_op (expr) != FFEBLD_opFUNCREF)
-	    break;
-
-	  if (sz == FFETARGET_charactersizeNONE)
-	    /* ~~Kludge alert!  This should someday be fixed. */
-	    sz = 24;
-
-	  tempvar = ffecom_make_tempvar ("char", char_type_node, sz, -1);
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFEBLD_opCONCATENATE:
-      {
-	/* This gets special handling, because only one set of temps
-	   is needed for a tree of these -- the tree is treated as
-	   a flattened list of concatenations when generating code.  */
-
-	ffecomConcatList_ catlist;
-	tree ltmp, itmp, result;
-	int count;
-	int i;
-
-	catlist = ffecom_concat_list_new_ (expr, FFETARGET_charactersizeNONE);
-	count = ffecom_concat_list_count_ (catlist);
-
-	if (count >= 2)
-	  {
-	    ltmp
-	      = ffecom_make_tempvar ("concat_len",
-				     ffecom_f2c_ftnlen_type_node,
-				     FFETARGET_charactersizeNONE, count);
-	    itmp
-	      = ffecom_make_tempvar ("concat_item",
-				     ffecom_f2c_address_type_node,
-				     FFETARGET_charactersizeNONE, count);
-	    result
-	      = ffecom_make_tempvar ("concat_res",
-				     char_type_node,
-				     ffecom_concat_list_maxlen_ (catlist),
-				     -1);
-
-	    tempvar = make_tree_vec (3);
-	    TREE_VEC_ELT (tempvar, 0) = ltmp;
-	    TREE_VEC_ELT (tempvar, 1) = itmp;
-	    TREE_VEC_ELT (tempvar, 2) = result;
-	  }
-
-	for (i = 0; i < count; ++i)
-	  ffecom_prepare_arg_ptr_to_expr (ffecom_concat_list_expr_ (catlist,
-								    i));
-
-	ffecom_concat_list_kill_ (catlist);
-
-	if (tempvar)
-	  {
-	    ffebld_nonter_set_hook (expr, tempvar);
-	    current_binding_level->prep_state = 1;
-	  }
-      }
-      return;
-
-    case FFEBLD_opCONVERT:
-      if (bt == FFEINFO_basictypeCHARACTER
-	  && ((ffebld_size_known (ffebld_left (expr))
-	       == FFETARGET_charactersizeNONE)
-	      || (ffebld_size_known (ffebld_left (expr)) >= sz)))
-	tempvar = ffecom_make_tempvar ("convert", char_type_node, sz, -1);
-      break;
-    }
-
-  if (tempvar)
-    {
-      ffebld_nonter_set_hook (expr, tempvar);
-      current_binding_level->prep_state = 1;
-    }
-
-  /* Prepare subexpressions for this expr.  */
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opPERCENT_LOC:
-      ffecom_prepare_ptr_to_expr (ffebld_left (expr));
-      break;
-
-    case FFEBLD_opPERCENT_VAL:
-    case FFEBLD_opPERCENT_REF:
-      ffecom_prepare_expr (ffebld_left (expr));
-      break;
-
-    case FFEBLD_opPERCENT_DESCR:
-      ffecom_prepare_arg_ptr_to_expr (ffebld_left (expr));
-      break;
-
-    case FFEBLD_opITEM:
-      {
-	ffebld item;
-
-	for (item = expr;
-	     item != NULL;
-	     item = ffebld_trail (item))
-	  if (ffebld_head (item) != NULL)
-	    ffecom_prepare_expr (ffebld_head (item));
-      }
-      break;
-
-    default:
-      /* Need to handle character conversion specially.  */
-      switch (ffebld_arity (expr))
-	{
-	case 2:
-	  ffecom_prepare_expr (ffebld_left (expr));
-	  ffecom_prepare_expr (ffebld_right (expr));
-	  break;
-
-	case 1:
-	  ffecom_prepare_expr (ffebld_left (expr));
-	  break;
-
-	default:
-	  break;
-	}
-    }
-
-  return;
-}
-
-/* Prepare expression for reading and writing.
-
-   Like ffecom_prepare_expr, except for expressions to be evaluated
-   via ffecom_expr_rw.  */
-
-void
-ffecom_prepare_expr_rw (tree type, ffebld expr)
-{
-  /* This is all we support for now.  */
-  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
-
-  /* ~~For now, it seems to be the same thing.  */
-  ffecom_prepare_expr (expr);
-  return;
-}
-
-/* Prepare expression for writing.
-
-   Like ffecom_prepare_expr, except for expressions to be evaluated
-   via ffecom_expr_w.  */
-
-void
-ffecom_prepare_expr_w (tree type, ffebld expr)
-{
-  /* This is all we support for now.  */
-  assert (type == NULL_TREE || type == ffecom_type_expr (expr));
-
-  /* ~~For now, it seems to be the same thing.  */
-  ffecom_prepare_expr (expr);
-  return;
-}
-
-/* Prepare expression for returning.
-
-   Like ffecom_prepare_expr, except for expressions to be evaluated
-   via ffecom_return_expr.  */
-
-void
-ffecom_prepare_return_expr (ffebld expr)
-{
-  assert (current_binding_level->prep_state < 2);
-
-  if (ffecom_primary_entry_kind_ == FFEINFO_kindSUBROUTINE
-      && ffecom_is_altreturning_
-      && expr != NULL)
-    ffecom_prepare_expr (expr);
-}
-
-/* Prepare pointer to expression.
-
-   Like ffecom_prepare_expr, except for expressions to be evaluated
-   via ffecom_ptr_to_expr.  */
-
-void
-ffecom_prepare_ptr_to_expr (ffebld expr)
-{
-  /* ~~For now, it seems to be the same thing.  */
-  ffecom_prepare_expr (expr);
-  return;
-}
-
-/* Transform expression into constant pointer-to-expression tree.
-
-   If the expression can be transformed into a pointer-to-expression tree
-   that is constant, that is done, and the tree returned.  Else NULL_TREE
-   is returned.
-
-   That way, a caller can attempt to provide compile-time initialization
-   of a variable and, if that fails, *then* choose to start a new block
-   and resort to using temporaries, as appropriate.  */
-
-tree
-ffecom_ptr_to_const_expr (ffebld expr)
-{
-  if (! expr)
-    return integer_zero_node;
-
-  if (ffebld_op (expr) == FFEBLD_opANY)
-    return error_mark_node;
-
-  if (ffebld_arity (expr) == 0
-      && (ffebld_op (expr) != FFEBLD_opSYMTER
-	  || ffebld_where (expr) == FFEINFO_whereCOMMON
-	  || ffebld_where (expr) == FFEINFO_whereGLOBAL
-	  || ffebld_where (expr) == FFEINFO_whereINTRINSIC))
-    {
-      tree t;
-
-      t = ffecom_ptr_to_expr (expr);
-      assert (TREE_CONSTANT (t));
-      return t;
-    }
-
-  return NULL_TREE;
-}
-
-/* ffecom_return_expr -- Returns return-value expr given alt return expr
-
-   tree rtn;  // NULL_TREE means use expand_null_return()
-   ffebld expr;	 // NULL if no alt return expr to RETURN stmt
-   rtn = ffecom_return_expr(expr);
-
-   Based on the program unit type and other info (like return function
-   type, return master function type when alternate ENTRY points,
-   whether subroutine has any alternate RETURN points, etc), returns the
-   appropriate expression to be returned to the caller, or NULL_TREE
-   meaning no return value or the caller expects it to be returned somewhere
-   else (which is handled by other parts of this module).  */
-
-tree
-ffecom_return_expr (ffebld expr)
-{
-  tree rtn;
-
-  switch (ffecom_primary_entry_kind_)
-    {
-    case FFEINFO_kindPROGRAM:
-    case FFEINFO_kindBLOCKDATA:
-      rtn = NULL_TREE;
-      break;
-
-    case FFEINFO_kindSUBROUTINE:
-      if (!ffecom_is_altreturning_)
-	rtn = NULL_TREE;	/* No alt returns, never an expr. */
-      else if (expr == NULL)
-	rtn = integer_zero_node;
-      else
-	rtn = ffecom_expr (expr);
-      break;
-
-    case FFEINFO_kindFUNCTION:
-      if ((ffecom_multi_retval_ != NULL_TREE)
-	  || (ffesymbol_basictype (ffecom_primary_entry_)
-	      == FFEINFO_basictypeCHARACTER)
-	  || ((ffesymbol_basictype (ffecom_primary_entry_)
-	       == FFEINFO_basictypeCOMPLEX)
-	      && (ffecom_num_entrypoints_ == 0)
-	      && ffesymbol_is_f2c (ffecom_primary_entry_)))
-	{			/* Value is returned by direct assignment
-				   into (implicit) dummy. */
-	  rtn = NULL_TREE;
-	  break;
-	}
-      rtn = ffecom_func_result_;
-#if 0
-      /* Spurious error if RETURN happens before first reference!  So elide
-	 this code.  In particular, for debugging registry, rtn should always
-	 be non-null after all, but TREE_USED won't be set until we encounter
-	 a reference in the code.  Perfectly okay (but weird) code that,
-	 e.g., has "GOTO 20;10 RETURN;20 RTN=0;GOTO 10", would result in
-	 this diagnostic for no reason.  Have people use -O -Wuninitialized
-	 and leave it to the back end to find obviously weird cases.  */
-
-      /* Used to "assert(rtn != NULL_TREE);" here, but it's kind of a valid
-	 situation; if the return value has never been referenced, it won't
-	 have a tree under 2pass mode. */
-      if ((rtn == NULL_TREE)
-	  || !TREE_USED (rtn))
-	{
-	  ffebad_start (FFEBAD_RETURN_VALUE_UNSET);
-	  ffebad_here (0, ffesymbol_where_line (ffecom_primary_entry_),
-		       ffesymbol_where_column (ffecom_primary_entry_));
-	  ffebad_string (ffesymbol_text (ffesymbol_funcresult
-					 (ffecom_primary_entry_)));
-	  ffebad_finish ();
-	}
-#endif
-      break;
-
-    default:
-      assert ("bad unit kind" == NULL);
-    case FFEINFO_kindANY:
-      rtn = error_mark_node;
-      break;
-    }
-
-  return rtn;
-}
-
-/* Do save_expr only if tree is not error_mark_node.  */
-
-tree
-ffecom_save_tree (tree t)
-{
-  return save_expr (t);
-}
-
-/* Start a compound statement (block).  */
-
-void
-ffecom_start_compstmt (void)
-{
-  bison_rule_pushlevel_ ();
-}
-
-/* Public entry point for front end to access start_decl.  */
-
-tree
-ffecom_start_decl (tree decl, bool is_initialized)
-{
-  DECL_INITIAL (decl) = is_initialized ? error_mark_node : NULL_TREE;
-  return start_decl (decl, FALSE);
-}
-
-/* ffecom_sym_commit -- Symbol's state being committed to reality
-
-   ffesymbol s;
-   ffecom_sym_commit(s);
-
-   Does whatever the backend needs when a symbol is committed after having
-   been backtrackable for a period of time.  */
-
-void
-ffecom_sym_commit (ffesymbol s UNUSED)
-{
-  assert (!ffesymbol_retractable ());
-}
-
-/* ffecom_sym_end_transition -- Perform end transition on all symbols
-
-   ffecom_sym_end_transition();
-
-   Does backend-specific stuff and also calls ffest_sym_end_transition
-   to do the necessary FFE stuff.
-
-   Backtracking is never enabled when this fn is called, so don't worry
-   about it.  */
-
-ffesymbol
-ffecom_sym_end_transition (ffesymbol s)
-{
-  ffestorag st;
-
-  assert (!ffesymbol_retractable ());
-
-  s = ffest_sym_end_transition (s);
-
-  if ((ffesymbol_kind (s) == FFEINFO_kindBLOCKDATA)
-      && (ffesymbol_where (s) == FFEINFO_whereGLOBAL))
-    {
-      ffecom_list_blockdata_
-	= ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE,
-					      FFEINTRIN_specNONE,
-					      FFEINTRIN_impNONE),
-			   ffecom_list_blockdata_);
-    }
-
-  /* This is where we finally notice that a symbol has partial initialization
-     and finalize it. */
-
-  if (ffesymbol_accretion (s) != NULL)
-    {
-      assert (ffesymbol_init (s) == NULL);
-      ffecom_notify_init_symbol (s);
-    }
-  else if (((st = ffesymbol_storage (s)) != NULL)
-	   && ((st = ffestorag_parent (st)) != NULL)
-	   && (ffestorag_accretion (st) != NULL))
-    {
-      assert (ffestorag_init (st) == NULL);
-      ffecom_notify_init_storage (st);
-    }
-
-  if ((ffesymbol_kind (s) == FFEINFO_kindCOMMON)
-      && (ffesymbol_where (s) == FFEINFO_whereLOCAL)
-      && (ffesymbol_storage (s) != NULL))
-    {
-      ffecom_list_common_
-	= ffebld_new_item (ffebld_new_symter (s, FFEINTRIN_genNONE,
-					      FFEINTRIN_specNONE,
-					      FFEINTRIN_impNONE),
-			   ffecom_list_common_);
-    }
-
-  return s;
-}
-
-/* ffecom_sym_exec_transition -- Perform exec transition on all symbols
-
-   ffecom_sym_exec_transition();
-
-   Does backend-specific stuff and also calls ffest_sym_exec_transition
-   to do the necessary FFE stuff.
-
-   See the long-winded description in ffecom_sym_learned for info
-   on handling the situation where backtracking is inhibited.  */
-
-ffesymbol
-ffecom_sym_exec_transition (ffesymbol s)
-{
-  s = ffest_sym_exec_transition (s);
-
-  return s;
-}
-
-/* ffecom_sym_learned -- Initial or more info gained on symbol after exec
-
-   ffesymbol s;
-   s = ffecom_sym_learned(s);
-
-   Called when a new symbol is seen after the exec transition or when more
-   info (perhaps) is gained for an UNCERTAIN symbol.  The symbol state when
-   it arrives here is that all its latest info is updated already, so its
-   state may be UNCERTAIN or UNDERSTOOD, it might already have the hook
-   field filled in if its gone through here or exec_transition first, and
-   so on.
-
-   The backend probably wants to check ffesymbol_retractable() to see if
-   backtracking is in effect.  If so, the FFE's changes to the symbol may
-   be retracted (undone) or committed (ratified), at which time the
-   appropriate ffecom_sym_retract or _commit function will be called
-   for that function.
-
-   If the backend has its own backtracking mechanism, great, use it so that
-   committal is a simple operation.  Though it doesn't make much difference,
-   I suppose: the reason for tentative symbol evolution in the FFE is to
-   enable error detection in weird incorrect statements early and to disable
-   incorrect error detection on a correct statement.  The backend is not
-   likely to introduce any information that'll get involved in these
-   considerations, so it is probably just fine that the implementation
-   model for this fn and for _exec_transition is to not do anything
-   (besides the required FFE stuff) if ffesymbol_retractable() returns TRUE
-   and instead wait until ffecom_sym_commit is called (which it never
-   will be as long as we're using ambiguity-detecting statement analysis in
-   the FFE, which we are initially to shake out the code, but don't depend
-   on this), otherwise go ahead and do whatever is needed.
-
-   In essence, then, when this fn and _exec_transition get called while
-   backtracking is enabled, a general mechanism would be to flag which (or
-   both) of these were called (and in what order? neat question as to what
-   might happen that I'm too lame to think through right now) and then when
-   _commit is called reproduce the original calling sequence, if any, for
-   the two fns (at which point backtracking will, of course, be disabled).  */
-
-ffesymbol
-ffecom_sym_learned (ffesymbol s)
-{
-  ffestorag_exec_layout (s);
-
-  return s;
-}
-
-/* ffecom_sym_retract -- Symbol's state being retracted from reality
-
-   ffesymbol s;
-   ffecom_sym_retract(s);
-
-   Does whatever the backend needs when a symbol is retracted after having
-   been backtrackable for a period of time.  */
-
-void
-ffecom_sym_retract (ffesymbol s UNUSED)
-{
-  assert (!ffesymbol_retractable ());
-
-#if 0				/* GCC doesn't commit any backtrackable sins,
-				   so nothing needed here. */
-  switch (ffesymbol_hook (s).state)
-    {
-    case 0:			/* nothing happened yet. */
-      break;
-
-    case 1:			/* exec transition happened. */
-      break;
-
-    case 2:			/* learned happened. */
-      break;
-
-    case 3:			/* learned then exec. */
-      break;
-
-    case 4:			/* exec then learned. */
-      break;
-
-    default:
-      assert ("bad hook state" == NULL);
-      break;
-    }
-#endif
-}
-
-/* Create temporary gcc label.  */
-
-tree
-ffecom_temp_label (void)
-{
-  tree glabel;
-  static int mynumber = 0;
-
-  glabel = build_decl (LABEL_DECL,
-		       ffecom_get_invented_identifier ("__g77_label_%d",
-						       mynumber++),
-		       void_type_node);
-  DECL_CONTEXT (glabel) = current_function_decl;
-  DECL_MODE (glabel) = VOIDmode;
-
-  return glabel;
-}
-
-/* Return an expression that is usable as an arg in a conditional context
-   (IF, DO WHILE, .NOT., and so on).
-
-   Use the one provided for the back end as of >2.6.0.  */
-
-tree
-ffecom_truth_value (tree expr)
-{
-  return ffe_truthvalue_conversion (expr);
-}
-
-/* Return the inversion of a truth value (the inversion of what
-   ffecom_truth_value builds).
-
-   Apparently invert_truthvalue, which is properly in the back end, is
-   enough for now, so just use it.  */
-
-tree
-ffecom_truth_value_invert (tree expr)
-{
-  return invert_truthvalue (ffecom_truth_value (expr));
-}
-
-/* Return the tree that is the type of the expression, as would be
-   returned in TREE_TYPE(ffecom_expr(expr)), without otherwise
-   transforming the expression, generating temporaries, etc.  */
-
-tree
-ffecom_type_expr (ffebld expr)
-{
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  tree tree_type;
-
-  assert (expr != NULL);
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-  tree_type = ffecom_tree_type[bt][kt];
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opCONTER:
-    case FFEBLD_opSYMTER:
-    case FFEBLD_opARRAYREF:
-    case FFEBLD_opUPLUS:
-    case FFEBLD_opPAREN:
-    case FFEBLD_opUMINUS:
-    case FFEBLD_opADD:
-    case FFEBLD_opSUBTRACT:
-    case FFEBLD_opMULTIPLY:
-    case FFEBLD_opDIVIDE:
-    case FFEBLD_opPOWER:
-    case FFEBLD_opNOT:
-    case FFEBLD_opFUNCREF:
-    case FFEBLD_opSUBRREF:
-    case FFEBLD_opAND:
-    case FFEBLD_opOR:
-    case FFEBLD_opXOR:
-    case FFEBLD_opNEQV:
-    case FFEBLD_opEQV:
-    case FFEBLD_opCONVERT:
-    case FFEBLD_opLT:
-    case FFEBLD_opLE:
-    case FFEBLD_opEQ:
-    case FFEBLD_opNE:
-    case FFEBLD_opGT:
-    case FFEBLD_opGE:
-    case FFEBLD_opPERCENT_LOC:
-      return tree_type;
-
-    case FFEBLD_opACCTER:
-    case FFEBLD_opARRTER:
-    case FFEBLD_opITEM:
-    case FFEBLD_opSTAR:
-    case FFEBLD_opBOUNDS:
-    case FFEBLD_opREPEAT:
-    case FFEBLD_opLABTER:
-    case FFEBLD_opLABTOK:
-    case FFEBLD_opIMPDO:
-    case FFEBLD_opCONCATENATE:
-    case FFEBLD_opSUBSTR:
-    default:
-      assert ("bad op for ffecom_type_expr" == NULL);
-      /* Fall through. */
-    case FFEBLD_opANY:
-      return error_mark_node;
-    }
-}
-
-/* Return PARM_DECL for arg#1 of master fn containing alternate ENTRY points
-
-   If the PARM_DECL already exists, return it, else create it.	It's an
-   integer_type_node argument for the master function that implements a
-   subroutine or function with more than one entrypoint and is bound at
-   run time with the entrypoint number (0 for SUBROUTINE/FUNCTION, 1 for
-   first ENTRY statement, and so on).  */
-
-tree
-ffecom_which_entrypoint_decl (void)
-{
-  assert (ffecom_which_entrypoint_decl_ != NULL_TREE);
-
-  return ffecom_which_entrypoint_decl_;
-}
-
-/* The following sections consists of private and public functions
-   that have the same names and perform roughly the same functions
-   as counterparts in the C front end.  Changes in the C front end
-   might affect how things should be done here.  Only functions
-   needed by the back end should be public here; the rest should
-   be private (static in the C sense).  Functions needed by other
-   g77 front-end modules should be accessed by them via public
-   ffecom_* names, which should themselves call private versions
-   in this section so the private versions are easy to recognize
-   when upgrading to a new gcc and finding interesting changes
-   in the front end.
-
-   Functions named after rule "foo:" in c-parse.y are named
-   "bison_rule_foo_" so they are easy to find.  */
-
-static void
-bison_rule_pushlevel_ (void)
-{
-  emit_line_note (input_location);
-  pushlevel (0);
-  clear_last_expr ();
-  expand_start_bindings (0);
-}
-
-static tree
-bison_rule_compstmt_ (void)
-{
-  tree t;
-  int keep = kept_level_p ();
-
-  /* Make the temps go away.  */
-  if (! keep)
-    current_binding_level->names = NULL_TREE;
-
-  emit_line_note (input_location);
-  expand_end_bindings (getdecls (), keep, 0);
-  t = poplevel (keep, 1, 0);
-
-  return t;
-}
-
-/* Return a definition for a builtin function named NAME and whose data type
-   is TYPE.  TYPE should be a function type with argument types.
-   FUNCTION_CODE tells later passes how to compile calls to this function.
-   See tree.h for its possible values.
-
-   If LIBRARY_NAME is nonzero, use that for DECL_ASSEMBLER_NAME,
-   the name to be called if we can't opencode the function.  If
-   ATTRS is nonzero, use that for the function's attribute list.  */
-
-tree
-builtin_function (const char *name, tree type, int function_code,
-		  enum built_in_class class, const char *library_name,
-		  tree attrs ATTRIBUTE_UNUSED)
-{
-  tree decl = build_decl (FUNCTION_DECL, get_identifier (name), type);
-  DECL_EXTERNAL (decl) = 1;
-  TREE_PUBLIC (decl) = 1;
-  if (library_name)
-    SET_DECL_ASSEMBLER_NAME (decl, get_identifier (library_name));
-  make_decl_rtl (decl, NULL);
-  pushdecl (decl);
-  DECL_BUILT_IN_CLASS (decl) = class;
-  DECL_FUNCTION_CODE (decl) = function_code;
-
-  return decl;
-}
-
-/* Handle when a new declaration NEWDECL
-   has the same name as an old one OLDDECL
-   in the same binding contour.
-   Prints an error message if appropriate.
-
-   If safely possible, alter OLDDECL to look like NEWDECL, and return 1.
-   Otherwise, return 0.  */
-
-static int
-duplicate_decls (tree newdecl, tree olddecl)
-{
-  int types_match = 1;
-  int new_is_definition = (TREE_CODE (newdecl) == FUNCTION_DECL
-			   && DECL_INITIAL (newdecl) != 0);
-  tree oldtype = TREE_TYPE (olddecl);
-  tree newtype = TREE_TYPE (newdecl);
-
-  if (olddecl == newdecl)
-    return 1;
-
-  if (TREE_CODE (newtype) == ERROR_MARK
-      || TREE_CODE (oldtype) == ERROR_MARK)
-    types_match = 0;
-
-  /* New decl is completely inconsistent with the old one =>
-     tell caller to replace the old one.
-     This is always an error except in the case of shadowing a builtin.  */
-  if (TREE_CODE (olddecl) != TREE_CODE (newdecl))
-    return 0;
-
-  /* For real parm decl following a forward decl,
-     return 1 so old decl will be reused.  */
-  if (types_match && TREE_CODE (newdecl) == PARM_DECL
-      && TREE_ASM_WRITTEN (olddecl) && ! TREE_ASM_WRITTEN (newdecl))
-    return 1;
-
-  /* The new declaration is the same kind of object as the old one.
-     The declarations may partially match.  Print warnings if they don't
-     match enough.  Ultimately, copy most of the information from the new
-     decl to the old one, and keep using the old one.  */
-
-  if (TREE_CODE (olddecl) == FUNCTION_DECL
-      && DECL_BUILT_IN (olddecl))
-    {
-      /* A function declaration for a built-in function.  */
-      if (!TREE_PUBLIC (newdecl))
-	return 0;
-      else if (!types_match)
-	{
-	  /* Accept the return type of the new declaration if same modes.  */
-	  tree oldreturntype = TREE_TYPE (TREE_TYPE (olddecl));
-	  tree newreturntype = TREE_TYPE (TREE_TYPE (newdecl));
-
-	  if (TYPE_MODE (oldreturntype) == TYPE_MODE (newreturntype))
-	    {
-	      /* Function types may be shared, so we can't just modify
-		 the return type of olddecl's function type.  */
-	      tree newtype
-		= build_function_type (newreturntype,
-				       TYPE_ARG_TYPES (TREE_TYPE (olddecl)));
-
-	      types_match = 1;
-	      if (types_match)
-		TREE_TYPE (olddecl) = newtype;
-	    }
-	}
-      if (!types_match)
-	return 0;
-    }
-  else if (TREE_CODE (olddecl) == FUNCTION_DECL
-	   && DECL_SOURCE_LINE (olddecl) == 0)
-    {
-      /* A function declaration for a predeclared function
-	 that isn't actually built in.  */
-      if (!TREE_PUBLIC (newdecl))
-	return 0;
-      else if (!types_match)
-	{
-	  /* If the types don't match, preserve volatility indication.
-	     Later on, we will discard everything else about the
-	     default declaration.  */
-	  TREE_THIS_VOLATILE (newdecl) |= TREE_THIS_VOLATILE (olddecl);
-	}
-    }
-
-  /* Copy all the DECL_... slots specified in the new decl
-     except for any that we copy here from the old type.
-
-     Past this point, we don't change OLDTYPE and NEWTYPE
-     even if we change the types of NEWDECL and OLDDECL.  */
-
-  if (types_match)
-    {
-      /* Merge the data types specified in the two decls.  */
-      if (TREE_CODE (newdecl) != FUNCTION_DECL || !DECL_BUILT_IN (olddecl))
-	TREE_TYPE (newdecl)
-	  = TREE_TYPE (olddecl)
-	    = TREE_TYPE (newdecl);
-
-      /* Lay the type out, unless already done.  */
-      if (oldtype != TREE_TYPE (newdecl))
-	{
-	  if (TREE_TYPE (newdecl) != error_mark_node)
-	    layout_type (TREE_TYPE (newdecl));
-	  if (TREE_CODE (newdecl) != FUNCTION_DECL
-	      && TREE_CODE (newdecl) != TYPE_DECL
-	      && TREE_CODE (newdecl) != CONST_DECL)
-	    layout_decl (newdecl, 0);
-	}
-      else
-	{
-	  /* Since the type is OLDDECL's, make OLDDECL's size go with.  */
-	  DECL_SIZE (newdecl) = DECL_SIZE (olddecl);
-	  DECL_SIZE_UNIT (newdecl) = DECL_SIZE_UNIT (olddecl);
-	  if (TREE_CODE (olddecl) != FUNCTION_DECL)
-	    if (DECL_ALIGN (olddecl) > DECL_ALIGN (newdecl))
-	      {
-		DECL_ALIGN (newdecl) = DECL_ALIGN (olddecl);
-		DECL_USER_ALIGN (newdecl) |= DECL_USER_ALIGN (olddecl);
-	      }
-	}
-
-      /* Keep the old rtl since we can safely use it.  */
-      COPY_DECL_RTL (olddecl, newdecl);
-
-      /* Merge the type qualifiers.  */
-      if (TREE_READONLY (newdecl))
-	TREE_READONLY (olddecl) = 1;
-      if (TREE_THIS_VOLATILE (newdecl))
-	{
-	  TREE_THIS_VOLATILE (olddecl) = 1;
-	  if (TREE_CODE (newdecl) == VAR_DECL)
-	    make_var_volatile (newdecl);
-	}
-
-      /* Keep source location of definition rather than declaration.
-	 Likewise, keep decl at outer scope.  */
-      if ((DECL_INITIAL (newdecl) == 0 && DECL_INITIAL (olddecl) != 0)
-	  || (DECL_CONTEXT (newdecl) != 0 && DECL_CONTEXT (olddecl) == 0))
-	{
-	  DECL_SOURCE_LOCATION (newdecl) = DECL_SOURCE_LOCATION (olddecl);
-
-	  if (DECL_CONTEXT (olddecl) == 0
-	      && TREE_CODE (newdecl) != FUNCTION_DECL)
-	    DECL_CONTEXT (newdecl) = 0;
-	}
-
-      /* Merge the unused-warning information.  */
-      if (DECL_IN_SYSTEM_HEADER (olddecl))
-	DECL_IN_SYSTEM_HEADER (newdecl) = 1;
-      else if (DECL_IN_SYSTEM_HEADER (newdecl))
-	DECL_IN_SYSTEM_HEADER (olddecl) = 1;
-
-      /* Merge the initialization information.  */
-      if (DECL_INITIAL (newdecl) == 0)
-	DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
-
-      /* Merge the section attribute.
-	 We want to issue an error if the sections conflict but that must be
-	 done later in decl_attributes since we are called before attributes
-	 are assigned.  */
-      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,
-     and don't preserve the old rtl.  */
-  else
-    {
-      TREE_TYPE (olddecl) = TREE_TYPE (newdecl);
-      TREE_READONLY (olddecl) = TREE_READONLY (newdecl);
-      TREE_THIS_VOLATILE (olddecl) = TREE_THIS_VOLATILE (newdecl);
-      TREE_SIDE_EFFECTS (olddecl) = TREE_SIDE_EFFECTS (newdecl);
-    }
-
-  /* Merge the storage class information.  */
-  /* For functions, static overrides non-static.  */
-  if (TREE_CODE (newdecl) == FUNCTION_DECL)
-    {
-      TREE_PUBLIC (newdecl) &= TREE_PUBLIC (olddecl);
-      /* This is since we don't automatically
-	 copy the attributes of NEWDECL into OLDDECL.  */
-      TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl);
-      /* If this clears `static', clear it in the identifier too.  */
-      if (! TREE_PUBLIC (olddecl))
-	TREE_PUBLIC (DECL_NAME (olddecl)) = 0;
-    }
-  if (DECL_EXTERNAL (newdecl))
-    {
-      TREE_STATIC (newdecl) = TREE_STATIC (olddecl);
-      DECL_EXTERNAL (newdecl) = DECL_EXTERNAL (olddecl);
-      /* An extern decl does not override previous storage class.  */
-      TREE_PUBLIC (newdecl) = TREE_PUBLIC (olddecl);
-    }
-  else
-    {
-      TREE_STATIC (olddecl) = TREE_STATIC (newdecl);
-      TREE_PUBLIC (olddecl) = TREE_PUBLIC (newdecl);
-    }
-
-  /* If either decl says `inline', this fn is inline,
-     unless its definition was passed already.  */
-  if (DECL_INLINE (newdecl) && DECL_INITIAL (olddecl) == 0)
-    DECL_INLINE (olddecl) = 1;
-  DECL_INLINE (newdecl) = DECL_INLINE (olddecl);
-
-  /* Get rid of any built-in function if new arg types don't match it
-     or if we have a function definition.  */
-  if (TREE_CODE (newdecl) == FUNCTION_DECL
-      && DECL_BUILT_IN (olddecl)
-      && (!types_match || new_is_definition))
-    {
-      TREE_TYPE (olddecl) = TREE_TYPE (newdecl);
-      DECL_BUILT_IN_CLASS (olddecl) = NOT_BUILT_IN;
-    }
-
-  /* If redeclaring a builtin function, and not a definition,
-     it stays built in.
-     Also preserve various other info from the definition.  */
-  if (TREE_CODE (newdecl) == FUNCTION_DECL && !new_is_definition)
-    {
-      if (DECL_BUILT_IN (olddecl))
-	{
-	  DECL_BUILT_IN_CLASS (newdecl) = DECL_BUILT_IN_CLASS (olddecl);
-	  DECL_FUNCTION_CODE (newdecl) = DECL_FUNCTION_CODE (olddecl);
-	}
-
-      DECL_RESULT (newdecl) = DECL_RESULT (olddecl);
-      DECL_INITIAL (newdecl) = DECL_INITIAL (olddecl);
-      DECL_STRUCT_FUNCTION (newdecl) = DECL_STRUCT_FUNCTION (olddecl);
-      DECL_ARGUMENTS (newdecl) = DECL_ARGUMENTS (olddecl);
-    }
-
-  /* Copy most of the decl-specific fields of NEWDECL into OLDDECL.
-     But preserve olddecl's DECL_UID.  */
-  {
-    register unsigned olddecl_uid = DECL_UID (olddecl);
-
-    memcpy ((char *) olddecl + sizeof (struct tree_common),
-	    (char *) newdecl + sizeof (struct tree_common),
-	    sizeof (struct tree_decl) - sizeof (struct tree_common));
-    DECL_UID (olddecl) = olddecl_uid;
-  }
-
-  return 1;
-}
-
-/* Finish processing of a declaration;
-   install its initial value.
-   If the length of an array type is not known before,
-   it must be determined now, from the initial value, or it is an error.  */
-
-static void
-finish_decl (tree decl, tree init, bool is_top_level)
-{
-  register tree type = TREE_TYPE (decl);
-  int was_incomplete = (DECL_SIZE (decl) == 0);
-  bool at_top_level = (current_binding_level == global_binding_level);
-  bool top_level = is_top_level || at_top_level;
-
-  /* Caller should pass TRUE for is_top_level only if we wouldn't be at top
-     level anyway.  */
-  assert (!is_top_level || !at_top_level);
-
-  if (TREE_CODE (decl) == PARM_DECL)
-    assert (init == NULL_TREE);
-  /* Remember that PARM_DECL doesn't have a DECL_INITIAL field per se -- it
-     overlaps DECL_ARG_TYPE.  */
-  else if (init == NULL_TREE)
-    assert (DECL_INITIAL (decl) == NULL_TREE);
-  else
-    assert (DECL_INITIAL (decl) == error_mark_node);
-
-  if (init != NULL_TREE)
-    {
-      if (TREE_CODE (decl) != TYPE_DECL)
-	DECL_INITIAL (decl) = init;
-      else
-	{
-	  /* typedef foo = bar; store the type of bar as the type of foo.  */
-	  TREE_TYPE (decl) = TREE_TYPE (init);
-	  DECL_INITIAL (decl) = init = 0;
-	}
-    }
-
-  /* Deduce size of array from initialization, if not already known */
-
-  if (TREE_CODE (type) == ARRAY_TYPE
-      && TYPE_DOMAIN (type) == 0
-      && TREE_CODE (decl) != TYPE_DECL)
-    {
-      assert (top_level);
-      assert (was_incomplete);
-
-      layout_decl (decl, 0);
-    }
-
-  if (TREE_CODE (decl) == VAR_DECL)
-    {
-      if (DECL_SIZE (decl) == NULL_TREE
-	  && TYPE_SIZE (TREE_TYPE (decl)) != NULL_TREE)
-	layout_decl (decl, 0);
-
-      if (DECL_SIZE (decl) == NULL_TREE
-	  && (TREE_STATIC (decl)
-	      ?
-      /* A static variable with an incomplete type is an error if it is
-	 initialized. Also if it is not file scope. Otherwise, let it
-	 through, but if it is not `extern' then it may cause an error
-	 message later.  */
-	      (DECL_INITIAL (decl) != 0 || DECL_CONTEXT (decl) != 0)
-	      :
-      /* An automatic variable with an incomplete type is an error.  */
-	      !DECL_EXTERNAL (decl)))
-	{
-	  assert ("storage size not known" == NULL);
-	  abort ();
-	}
-
-      if ((DECL_EXTERNAL (decl) || TREE_STATIC (decl))
-	  && (DECL_SIZE (decl) != 0)
-	  && (TREE_CODE (DECL_SIZE (decl)) != INTEGER_CST))
-	{
-	  assert ("storage size not constant" == NULL);
-	  abort ();
-	}
-    }
-
-  /* Output the assembler code and/or RTL code for variables and functions,
-     unless the type is an undefined structure or union. If not, it will get
-     done when the type is completed.  */
-
-  if (TREE_CODE (decl) == VAR_DECL || TREE_CODE (decl) == FUNCTION_DECL)
-    {
-      rest_of_decl_compilation (decl, NULL,
-				DECL_CONTEXT (decl) == 0,
-				0);
-
-      if (DECL_CONTEXT (decl) != 0)
-	{
-	  /* Recompute the RTL of a local array now if it used to be an
-	     incomplete type.  */
-	  if (was_incomplete
-	      && !TREE_STATIC (decl) && !DECL_EXTERNAL (decl))
-	    {
-	      /* If we used it already as memory, it must stay in memory.  */
-	      TREE_ADDRESSABLE (decl) = TREE_USED (decl);
-	      /* If it's still incomplete now, no init will save it.  */
-	      if (DECL_SIZE (decl) == 0)
-		DECL_INITIAL (decl) = 0;
-	      expand_decl (decl);
-	    }
-	  /* Compute and store the initial value.  */
-	  if (TREE_CODE (decl) != FUNCTION_DECL)
-	    expand_decl_init (decl);
-	}
-    }
-  else if (TREE_CODE (decl) == TYPE_DECL)
-    {
-      rest_of_decl_compilation (decl, NULL,
-				DECL_CONTEXT (decl) == 0,
-				0);
-    }
-
-  /* At the end of a declaration, throw away any variable type sizes of types
-     defined inside that declaration.  There is no use computing them in the
-     following function definition.  */
-  if (current_binding_level == global_binding_level)
-    get_pending_sizes ();
-}
-
-/* Finish up a function declaration and compile that function
-   all the way to assembler language output.  The free the storage
-   for the function definition.
-
-   This is called after parsing the body of the function definition.
-
-   NESTED is nonzero if the function being finished is nested in another.  */
-
-static void
-finish_function (int nested)
-{
-  register tree fndecl = current_function_decl;
-
-  assert (fndecl != NULL_TREE);
-  if (TREE_CODE (fndecl) != ERROR_MARK)
-    {
-      if (nested)
-	assert (DECL_CONTEXT (fndecl) != NULL_TREE);
-      else
-	assert (DECL_CONTEXT (fndecl) == NULL_TREE);
-    }
-
-/*  TREE_READONLY (fndecl) = 1;
-    This caused &foo to be of type ptr-to-const-function
-    which then got a warning when stored in a ptr-to-function variable.  */
-
-  poplevel (1, 0, 1);
-
-  if (TREE_CODE (fndecl) != ERROR_MARK)
-    {
-      BLOCK_SUPERCONTEXT (DECL_INITIAL (fndecl)) = fndecl;
-
-      /* Must mark the RESULT_DECL as being in this function.  */
-
-      DECL_CONTEXT (DECL_RESULT (fndecl)) = fndecl;
-
-      /* Obey `register' declarations if `setjmp' is called in this fn.  */
-      /* Generate rtl for function exit.  */
-      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.  */
-      if (nested)
-	ggc_push_context ();
-
-      /* Run the optimizers and output the assembler code for this function.  */
-      rest_of_compilation (fndecl);
-      if (! DECL_DEFER_OUTPUT (fndecl))
-	{
-	  free_after_compilation (cfun);
-	  DECL_STRUCT_FUNCTION (fndecl) = 0;
-	}
-      cfun = 0;
-
-      /* Undo the GC context switch.  */
-      if (nested)
-	ggc_pop_context ();
-    }
-
-  if (TREE_CODE (fndecl) != ERROR_MARK
-      && !nested
-      && DECL_STRUCT_FUNCTION (fndecl) == 0)
-    {
-      /* Stop pointing to the local nodes about to be freed.  */
-      /* But DECL_INITIAL must remain nonzero so we know this was an actual
-	 function definition.  */
-      /* For a nested function, this is done in pop_f_function_context.  */
-      /* If rest_of_compilation set this to 0, leave it 0.  */
-      if (DECL_INITIAL (fndecl) != 0)
-	DECL_INITIAL (fndecl) = error_mark_node;
-      DECL_ARGUMENTS (fndecl) = 0;
-    }
-
-  if (!nested)
-    {
-      /* Let the error reporting routines know that we're outside a function.
-	 For a nested function, this value is used in pop_c_function_context
-	 and then reset via pop_function_context.  */
-      ffecom_outer_function_decl_ = current_function_decl = NULL;
-    }
-}
-
-/* Plug-in replacement for identifying the name of a decl and, for a
-   function, what we call it in diagnostics.  For now, "program unit"
-   should suffice, since it's a bit of a hassle to figure out which
-   of several kinds of things it is.  Note that it could conceivably
-   be a statement function, which probably isn't really a program unit
-   per se, but if that comes up, it should be easy to check (being a
-   nested function and all).  */
-
-static const char *
-ffe_printable_name (tree decl, int v)
-{
-  /* Just to keep GCC quiet about the unused variable.
-     In theory, differing values of V should produce different
-     output.  */
-  switch (v)
-    {
-    default:
-      if (TREE_CODE (decl) == ERROR_MARK)
-	return "erroneous code";
-      return IDENTIFIER_POINTER (DECL_NAME (decl));
-    }
-}
-
-/* g77's function to print out name of current function that caused
-   an error.  */
-
-static void
-ffe_print_error_function (diagnostic_context *context __attribute__((unused)),
-			  const char *file)
-{
-  static ffeglobal last_g = NULL;
-  static ffesymbol last_s = NULL;
-  ffeglobal g;
-  ffesymbol s;
-  const char *kind;
-
-  if ((ffecom_primary_entry_ == NULL)
-      || (ffesymbol_global (ffecom_primary_entry_) == NULL))
-    {
-      g = NULL;
-      s = NULL;
-      kind = NULL;
-    }
-  else
-    {
-      g = ffesymbol_global (ffecom_primary_entry_);
-      if (ffecom_nested_entry_ == NULL)
-	{
-	  s = ffecom_primary_entry_;
-	  kind = _(ffeinfo_kind_message (ffesymbol_kind (s)));
-	}
-      else
-	{
-	  s = ffecom_nested_entry_;
-	  kind = _("In statement function");
-	}
-    }
-
-  if ((last_g != g) || (last_s != s))
-    {
-      if (file)
-	fprintf (stderr, "%s: ", file);
-
-      if (s == NULL)
-	fprintf (stderr, _("Outside of any program unit:\n"));
-      else
-	{
-	  const char *name = ffesymbol_text (s);
-
-	  fprintf (stderr, "%s `%s':\n", kind, name);
-	}
-
-      last_g = g;
-      last_s = s;
-    }
-}
-
-/* Similar to `lookup_name' but look only at current binding level.  */
-
-static tree
-lookup_name_current_level (tree name)
-{
-  register tree t;
-
-  if (current_binding_level == global_binding_level)
-    return IDENTIFIER_GLOBAL_VALUE (name);
-
-  if (IDENTIFIER_LOCAL_VALUE (name) == 0)
-    return 0;
-
-  for (t = current_binding_level->names; t; t = TREE_CHAIN (t))
-    if (DECL_NAME (t) == name)
-      break;
-
-  return t;
-}
-
-/* Create a new `struct f_binding_level'.  */
-
-static struct f_binding_level *
-make_binding_level (void)
-{
-  /* NOSTRICT */
-  return ggc_alloc (sizeof (struct f_binding_level));
-}
-
-/* Save and restore the variables in this file and elsewhere
-   that keep track of the progress of compilation of the current function.
-   Used for nested functions.  */
-
-struct f_function
-{
-  struct f_function *next;
-  tree named_labels;
-  tree shadowed_labels;
-  struct f_binding_level *binding_level;
-};
-
-struct f_function *f_function_chain;
-
-/* Restore the variables used during compilation of a C function.  */
-
-static void
-pop_f_function_context (void)
-{
-  struct f_function *p = f_function_chain;
-  tree link;
-
-  /* Bring back all the labels that were shadowed.  */
-  for (link = shadowed_labels; link; link = TREE_CHAIN (link))
-    if (DECL_NAME (TREE_VALUE (link)) != 0)
-      IDENTIFIER_LABEL_VALUE (DECL_NAME (TREE_VALUE (link)))
-	= TREE_VALUE (link);
-
-  if (current_function_decl != error_mark_node
-      && DECL_STRUCT_FUNCTION (current_function_decl) == 0)
-    {
-      /* Stop pointing to the local nodes about to be freed.  */
-      /* But DECL_INITIAL must remain nonzero so we know this was an actual
-	 function definition.  */
-      DECL_INITIAL (current_function_decl) = error_mark_node;
-      DECL_ARGUMENTS (current_function_decl) = 0;
-    }
-
-  pop_function_context ();
-
-  f_function_chain = p->next;
-
-  named_labels = p->named_labels;
-  shadowed_labels = p->shadowed_labels;
-  current_binding_level = p->binding_level;
-
-  free (p);
-}
-
-/* Save and reinitialize the variables
-   used during compilation of a C function.  */
-
-static void
-push_f_function_context (void)
-{
-  struct f_function *p = xmalloc (sizeof (struct f_function));
-
-  push_function_context ();
-
-  p->next = f_function_chain;
-  f_function_chain = p;
-
-  p->named_labels = named_labels;
-  p->shadowed_labels = shadowed_labels;
-  p->binding_level = current_binding_level;
-}
-
-static void
-push_parm_decl (tree parm)
-{
-  int old_immediate_size_expand = immediate_size_expand;
-
-  /* Don't try computing parm sizes now -- wait till fn is called.  */
-
-  immediate_size_expand = 0;
-
-  /* Fill in arg stuff.  */
-
-  DECL_ARG_TYPE (parm) = TREE_TYPE (parm);
-  DECL_ARG_TYPE_AS_WRITTEN (parm) = TREE_TYPE (parm);
-  TREE_READONLY (parm) = 1;	/* All implementation args are read-only. */
-
-  parm = pushdecl (parm);
-
-  immediate_size_expand = old_immediate_size_expand;
-
-  finish_decl (parm, NULL_TREE, FALSE);
-}
-
-/* Like pushdecl, only it places X in GLOBAL_BINDING_LEVEL, if appropriate.  */
-
-static tree
-pushdecl_top_level (tree x)
-{
-  register tree t;
-  register struct f_binding_level *b = current_binding_level;
-  register tree f = current_function_decl;
-
-  current_binding_level = global_binding_level;
-  current_function_decl = NULL_TREE;
-  t = pushdecl (x);
-  current_binding_level = b;
-  current_function_decl = f;
-  return t;
-}
-
-/* Store the list of declarations of the current level.
-   This is done for the parameter declarations of a function being defined,
-   after they are modified in the light of any missing parameters.  */
-
-static tree
-storedecls (tree decls)
-{
-  return current_binding_level->names = decls;
-}
-
-/* Store the parameter declarations into the current function declaration.
-   This is called after parsing the parameter declarations, before
-   digesting the body of the function.
-
-   For an old-style definition, modify the function's type
-   to specify at least the number of arguments.  */
-
-static void
-store_parm_decls (int is_main_program UNUSED)
-{
-  register tree fndecl = current_function_decl;
-
-  if (fndecl == error_mark_node)
-    return;
-
-  /* This is a chain of PARM_DECLs from old-style parm declarations.  */
-  DECL_ARGUMENTS (fndecl) = storedecls (nreverse (getdecls ()));
-
-  /* Initialize the RTL code for the function.  */
-  init_function_start (fndecl);
-
-  /* Set up parameters and prepare for return, for the function.  */
-  expand_function_start (fndecl, 0);
-}
-
-static tree
-start_decl (tree decl, bool is_top_level)
-{
-  register tree tem;
-  bool at_top_level = (current_binding_level == global_binding_level);
-  bool top_level = is_top_level || at_top_level;
-
-  /* Caller should pass TRUE for is_top_level only if we wouldn't be at top
-     level anyway.  */
-  assert (!is_top_level || !at_top_level);
-
-  if (DECL_INITIAL (decl) != NULL_TREE)
-    {
-      assert (DECL_INITIAL (decl) == error_mark_node);
-      assert (!DECL_EXTERNAL (decl));
-    }
-  else if (top_level)
-    assert ((TREE_STATIC (decl) == 1) || DECL_EXTERNAL (decl) == 1);
-
-  /* For Fortran, we by default put things in .common when possible.  */
-  DECL_COMMON (decl) = 1;
-
-  /* Add this decl to the current binding level. TEM may equal DECL or it may
-     be a previous decl of the same name.  */
-  if (is_top_level)
-    tem = pushdecl_top_level (decl);
-  else
-    tem = pushdecl (decl);
-
-  /* For a local variable, define the RTL now.  */
-  if (!top_level
-  /* But not if this is a duplicate decl and we preserved the rtl from the
-     previous one (which may or may not happen).  */
-      && !DECL_RTL_SET_P (tem))
-    {
-      if (TYPE_SIZE (TREE_TYPE (tem)) != 0)
-	expand_decl (tem);
-      else if (TREE_CODE (TREE_TYPE (tem)) == ARRAY_TYPE
-	       && DECL_INITIAL (tem) != 0)
-	expand_decl (tem);
-    }
-
-  return tem;
-}
-
-/* Create the FUNCTION_DECL for a function definition.
-   DECLSPECS and DECLARATOR are the parts of the declaration;
-   they describe the function's name and the type it returns,
-   but twisted together in a fashion that parallels the syntax of C.
-
-   This function creates a binding context for the function body
-   as well as setting up the FUNCTION_DECL in current_function_decl.
-
-   Returns 1 on success.  If the DECLARATOR is not suitable for a function
-   (it defines a datum instead), we return 0, which tells
-   ffe_parse_file to report a parse error.
-
-   NESTED is nonzero for a function nested within another function.  */
-
-static void
-start_function (tree name, tree type, int nested, int public)
-{
-  tree decl1;
-  tree restype;
-  int old_immediate_size_expand = immediate_size_expand;
-
-  named_labels = 0;
-  shadowed_labels = 0;
-
-  /* Don't expand any sizes in the return type of the function.  */
-  immediate_size_expand = 0;
-
-  if (nested)
-    {
-      assert (!public);
-      assert (current_function_decl != NULL_TREE);
-      assert (DECL_CONTEXT (current_function_decl) == NULL_TREE);
-    }
-  else
-    {
-      assert (current_function_decl == NULL_TREE);
-    }
-
-  if (TREE_CODE (type) == ERROR_MARK)
-    decl1 = current_function_decl = error_mark_node;
-  else
-    {
-      decl1 = build_decl (FUNCTION_DECL,
-			  name,
-			  type);
-      TREE_PUBLIC (decl1) = public ? 1 : 0;
-      if (nested)
-	DECL_INLINE (decl1) = 1;
-      TREE_STATIC (decl1) = 1;
-      DECL_EXTERNAL (decl1) = 0;
-
-      announce_function (decl1);
-
-      /* Make the init_value nonzero so pushdecl knows this is not tentative.
-	 error_mark_node is replaced below (in poplevel) with the BLOCK.  */
-      DECL_INITIAL (decl1) = error_mark_node;
-
-      /* Record the decl so that the function name is defined. If we already have
-	 a decl for this name, and it is a FUNCTION_DECL, use the old decl.  */
-
-      current_function_decl = pushdecl (decl1);
-    }
-
-  if (!nested)
-    ffecom_outer_function_decl_ = current_function_decl;
-
-  pushlevel (0);
-  current_binding_level->prep_state = 2;
-
-  if (TREE_CODE (current_function_decl) != ERROR_MARK)
-    {
-      make_decl_rtl (current_function_decl, NULL);
-
-      restype = TREE_TYPE (TREE_TYPE (current_function_decl));
-      DECL_RESULT (current_function_decl)
-	= build_decl (RESULT_DECL, NULL_TREE, restype);
-    }
-
-  if (!nested && (TREE_CODE (current_function_decl) != ERROR_MARK))
-    TREE_ADDRESSABLE (current_function_decl) = 1;
-
-  immediate_size_expand = old_immediate_size_expand;
-}
-
-/* Here are the public functions the GNU back end needs.  */
-
-tree
-convert (tree type, tree expr)
-{
-  register tree e = expr;
-  register enum tree_code code = TREE_CODE (type);
-
-  if (type == TREE_TYPE (e)
-      || TREE_CODE (e) == ERROR_MARK)
-    return e;
-  if (TYPE_MAIN_VARIANT (type) == TYPE_MAIN_VARIANT (TREE_TYPE (e)))
-    return fold (build1 (NOP_EXPR, type, e));
-  if (TREE_CODE (TREE_TYPE (e)) == ERROR_MARK
-      || code == ERROR_MARK)
-    return error_mark_node;
-  if (TREE_CODE (TREE_TYPE (e)) == VOID_TYPE)
-    {
-      assert ("void value not ignored as it ought to be" == NULL);
-      return error_mark_node;
-    }
-  if (code == VOID_TYPE)
-    return build1 (CONVERT_EXPR, type, e);
-  if ((code != RECORD_TYPE)
-      && (TREE_CODE (TREE_TYPE (e)) == RECORD_TYPE))
-    e = ffecom_1 (REALPART_EXPR, TREE_TYPE (TYPE_FIELDS (TREE_TYPE (e))),
-		  e);
-  if (code == INTEGER_TYPE || code == ENUMERAL_TYPE)
-    return fold (convert_to_integer (type, e));
-  if (code == POINTER_TYPE)
-    return fold (convert_to_pointer (type, e));
-  if (code == REAL_TYPE)
-    return fold (convert_to_real (type, e));
-  if (code == COMPLEX_TYPE)
-    return fold (convert_to_complex (type, e));
-  if (code == RECORD_TYPE)
-    return fold (ffecom_convert_to_complex_ (type, e));
-
-  assert ("conversion to non-scalar type requested" == NULL);
-  return error_mark_node;
-}
-
-/* Return the list of declarations of the current level.
-   Note that this list is in reverse order unless/until
-   you nreverse it; and when you do nreverse it, you must
-   store the result back using `storedecls' or you will lose.  */
-
-tree
-getdecls (void)
-{
-  return current_binding_level->names;
-}
-
-/* Nonzero if we are currently in the global binding level.  */
-
-int
-global_bindings_p (void)
-{
-  return current_binding_level == global_binding_level;
-}
-
-static void
-ffecom_init_decl_processing (void)
-{
-  malloc_init ();
-
-  ffe_init_0 ();
-}
-
-/* Delete the node BLOCK from the current binding level.
-   This is used for the block inside a stmt expr ({...})
-   so that the block can be reinserted where appropriate.  */
-
-static void
-delete_block (tree block)
-{
-  tree t;
-  if (current_binding_level->blocks == block)
-    current_binding_level->blocks = TREE_CHAIN (block);
-  for (t = current_binding_level->blocks; t;)
-    {
-      if (TREE_CHAIN (t) == block)
-	TREE_CHAIN (t) = TREE_CHAIN (block);
-      else
-	t = TREE_CHAIN (t);
-    }
-  TREE_CHAIN (block) = NULL;
-  /* Clear TREE_USED which is always set by poplevel.
-     The flag is set again if insert_block is called.  */
-  TREE_USED (block) = 0;
-}
-
-void
-insert_block (tree block)
-{
-  TREE_USED (block) = 1;
-  current_binding_level->blocks
-    = chainon (current_binding_level->blocks, block);
-}
-
-/* Each front end provides its own.  */
-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(())
-{
-  int unused;
-};
-
-#undef  LANG_HOOKS_NAME
-#define LANG_HOOKS_NAME			"GNU F77"
-#undef  LANG_HOOKS_INIT
-#define LANG_HOOKS_INIT			ffe_init
-#undef  LANG_HOOKS_FINISH
-#define LANG_HOOKS_FINISH		ffe_finish
-#undef  LANG_HOOKS_INIT_OPTIONS
-#define LANG_HOOKS_INIT_OPTIONS		ffe_init_options
-#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
-#define LANG_HOOKS_MARK_ADDRESSABLE	ffe_mark_addressable
-#undef  LANG_HOOKS_PRINT_IDENTIFIER
-#define LANG_HOOKS_PRINT_IDENTIFIER	ffe_print_identifier
-#undef  LANG_HOOKS_DECL_PRINTABLE_NAME
-#define LANG_HOOKS_DECL_PRINTABLE_NAME	ffe_printable_name
-#undef  LANG_HOOKS_PRINT_ERROR_FUNCTION
-#define LANG_HOOKS_PRINT_ERROR_FUNCTION ffe_print_error_function
-#undef  LANG_HOOKS_TRUTHVALUE_CONVERSION
-#define LANG_HOOKS_TRUTHVALUE_CONVERSION ffe_truthvalue_conversion
-
-#undef  LANG_HOOKS_TYPE_FOR_MODE
-#define LANG_HOOKS_TYPE_FOR_MODE	ffe_type_for_mode
-#undef  LANG_HOOKS_TYPE_FOR_SIZE
-#define LANG_HOOKS_TYPE_FOR_SIZE	ffe_type_for_size
-#undef  LANG_HOOKS_SIGNED_TYPE
-#define LANG_HOOKS_SIGNED_TYPE		ffe_signed_type
-#undef  LANG_HOOKS_UNSIGNED_TYPE
-#define LANG_HOOKS_UNSIGNED_TYPE	ffe_unsigned_type
-#undef  LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE
-#define LANG_HOOKS_SIGNED_OR_UNSIGNED_TYPE ffe_signed_or_unsigned_type
-
-/* We do not wish to use alias-set based aliasing at all.  Used in the
-   extreme (every object with its own set, with equivalences recorded) it
-   might be helpful, but there are problems when it comes to inlining.  We
-   get on ok with flag_argument_noalias, and alias-set aliasing does
-   currently limit how stack slots can be reused, which is a lose.  */
-#undef LANG_HOOKS_GET_ALIAS_SET
-#define LANG_HOOKS_GET_ALIAS_SET hook_get_alias_set_0
-
-const struct lang_hooks lang_hooks = LANG_HOOKS_INITIALIZER;
-
-/* Table indexed by tree code giving a string containing a character
-   classifying the tree code.  Possibilities are
-   t, d, s, c, r, <, 1, 2 and e.  See tree.def for details.  */
-
-#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) TYPE,
-
-const char tree_code_type[] = {
-#include "tree.def"
-};
-#undef DEFTREECODE
-
-/* Table indexed by tree code giving number of expression
-   operands beyond the fixed part of the node structure.
-   Not used for types or decls.  */
-
-#define DEFTREECODE(SYM, NAME, TYPE, LENGTH) LENGTH,
-
-const unsigned char tree_code_length[] = {
-#include "tree.def"
-};
-#undef DEFTREECODE
-
-/* Names of tree components.
-   Used for printing out the tree and error messages.  */
-#define DEFTREECODE(SYM, NAME, TYPE, LEN) NAME,
-
-const char *const tree_code_name[] = {
-#include "tree.def"
-};
-#undef DEFTREECODE
-
-static bool
-ffe_post_options (const char **pfilename)
-{
-  const char *filename = *pfilename;
-
-  /* Open input file.  */
-  if (filename == 0 || !strcmp (filename, "-"))
-    {
-      finput = stdin;
-      filename = "stdin";
-    }
-  else
-    finput = fopen (filename, "r");
-
-  if (finput == 0)
-    fatal_error ("can't open %s: %m", filename);
-
-  return false;
-}
-
-
-static bool
-ffe_init (void)
-{
-#ifdef IO_BUFFER_SIZE
-  setvbuf (finput, xmalloc (IO_BUFFER_SIZE), _IOFBF, IO_BUFFER_SIZE);
-#endif
-
-  ffecom_init_decl_processing ();
-
-  /* If the file is output from cpp, it should contain a first line
-     `# 1 "real-filename"', and the current design of gcc (toplev.c
-     in particular and the way it sets up information relied on by
-     INCLUDE) requires that we read this now, and store the
-     "real-filename" info in master_input_filename.  Ask the lexer
-     to try doing this.  */
-  ffelex_hash_kludge (finput);
-
-  push_srcloc (input_filename, 0);
-
-  /* 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 (void)
-{
-  ffe_terminate_0 ();
-
-  if (ffe_is_ffedebug ())
-    malloc_pool_display (malloc_pool_image ());
-
-  fclose (finput);
-}
-
-static bool
-ffe_mark_addressable (tree exp)
-{
-  register tree x = exp;
-  while (1)
-    switch (TREE_CODE (x))
-      {
-      case ADDR_EXPR:
-      case COMPONENT_REF:
-      case ARRAY_REF:
-	x = TREE_OPERAND (x, 0);
-	break;
-
-      case CONSTRUCTOR:
-	TREE_ADDRESSABLE (x) = 1;
-	return true;
-
-      case VAR_DECL:
-      case CONST_DECL:
-      case PARM_DECL:
-      case RESULT_DECL:
-	if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x)
-	    && DECL_NONLOCAL (x))
-	  {
-	    if (TREE_PUBLIC (x))
-	      {
-		assert ("address of global register var requested" == NULL);
-		return false;
-	      }
-	    assert ("address of register variable requested" == NULL);
-	  }
-	else if (DECL_REGISTER (x) && !TREE_ADDRESSABLE (x))
-	  {
-	    if (TREE_PUBLIC (x))
-	      {
-		assert ("address of global register var requested" == NULL);
-		return false;
-	      }
-	    assert ("address of register var requested" == NULL);
-	  }
-	put_var_into_stack (x, /*rescan=*/true);
-
-	/* drops in */
-      case FUNCTION_DECL:
-	TREE_ADDRESSABLE (x) = 1;
-#if 0				/* poplevel deals with this now.  */
-	if (DECL_CONTEXT (x) == 0)
-	  TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (x)) = 1;
-#endif
-
-      default:
-	return true;
-      }
-}
-
-/* Exit a binding level.
-   Pop the level off, and restore the state of the identifier-decl mappings
-   that were in effect when this level was entered.
-
-   If KEEP is nonzero, this level had explicit declarations, so
-   and create a "block" (a BLOCK node) for the level
-   to record its declarations and subblocks for symbol table output.
-
-   If FUNCTIONBODY is nonzero, this level is the body of a function,
-   so create a block as if KEEP were set and also clear out all
-   label names.
-
-   If REVERSE is nonzero, reverse the order of decls before putting
-   them into the BLOCK.  */
-
-tree
-poplevel (int keep, int reverse, int functionbody)
-{
-  register tree link;
-  /* The chain of decls was accumulated in reverse order.
-     Put it into forward order, just for cleanliness.  */
-  tree decls;
-  tree subblocks = current_binding_level->blocks;
-  tree block = 0;
-  tree decl;
-  int block_previously_created;
-
-  /* Get the decls in the order they were written.
-     Usually current_binding_level->names is in reverse order.
-     But parameter decls were previously put in forward order.  */
-
-  if (reverse)
-    current_binding_level->names
-      = decls = nreverse (current_binding_level->names);
-  else
-    decls = current_binding_level->names;
-
-  /* Output any nested inline functions within this block
-     if they weren't already output.  */
-
-  for (decl = decls; decl; decl = TREE_CHAIN (decl))
-    if (TREE_CODE (decl) == FUNCTION_DECL
-	&& ! TREE_ASM_WRITTEN (decl)
-	&& DECL_INITIAL (decl) != 0
-	&& TREE_ADDRESSABLE (decl))
-      {
-	/* If this decl was copied from a file-scope decl
-	   on account of a block-scope extern decl,
-	   propagate TREE_ADDRESSABLE to the file-scope decl.
-
-	   DECL_ABSTRACT_ORIGIN can be set to itself if warn_return_type is
-	   true, since then the decl goes through save_for_inline_copying.  */
-	if (DECL_ABSTRACT_ORIGIN (decl) != 0
-	    && DECL_ABSTRACT_ORIGIN (decl) != decl)
-	  TREE_ADDRESSABLE (DECL_ABSTRACT_ORIGIN (decl)) = 1;
-	else if (DECL_STRUCT_FUNCTION (decl) != 0)
-	  {
-	    push_function_context ();
-	    output_inline_function (decl);
-	    pop_function_context ();
-	  }
-      }
-
-  /* If there were any declarations or structure tags in that level,
-     or if this level is a function body,
-     create a BLOCK to record them for the life of this function.  */
-
-  block = 0;
-  block_previously_created = (current_binding_level->this_block != 0);
-  if (block_previously_created)
-    block = current_binding_level->this_block;
-  else if (keep || functionbody)
-    block = make_node (BLOCK);
-  if (block != 0)
-    {
-      BLOCK_VARS (block) = decls;
-      BLOCK_SUBBLOCKS (block) = subblocks;
-    }
-
-  /* In each subblock, record that this is its superior.  */
-
-  for (link = subblocks; link; link = TREE_CHAIN (link))
-    BLOCK_SUPERCONTEXT (link) = block;
-
-  /* Clear out the meanings of the local variables of this level.  */
-
-  for (link = decls; link; link = TREE_CHAIN (link))
-    {
-      if (DECL_NAME (link) != 0)
-	{
-	  /* If the ident. was used or addressed via a local extern decl,
-	     don't forget that fact.  */
-	  if (DECL_EXTERNAL (link))
-	    {
-	      if (TREE_USED (link))
-		TREE_USED (DECL_NAME (link)) = 1;
-	      if (TREE_ADDRESSABLE (link))
-		TREE_ADDRESSABLE (DECL_ASSEMBLER_NAME (link)) = 1;
-	    }
-	  IDENTIFIER_LOCAL_VALUE (DECL_NAME (link)) = 0;
-	}
-    }
-
-  /* If the level being exited is the top level of a function,
-     check over all the labels, and clear out the current
-     (function local) meanings of their names.  */
-
-  if (functionbody)
-    {
-      /* If this is the top level block of a function,
-	 the vars are the function's parameters.
-	 Don't leave them in the BLOCK because they are
-	 found in the FUNCTION_DECL instead.  */
-
-      BLOCK_VARS (block) = 0;
-    }
-
-  /* Pop the current level, and free the structure for reuse.  */
-
-  {
-    register struct f_binding_level *level = current_binding_level;
-    current_binding_level = current_binding_level->level_chain;
-
-    level->level_chain = free_binding_level;
-    free_binding_level = level;
-  }
-
-  /* Dispose of the block that we just made inside some higher level.  */
-  if (functionbody
-      && current_function_decl != error_mark_node)
-    DECL_INITIAL (current_function_decl) = block;
-  else if (block)
-    {
-      if (!block_previously_created)
-	current_binding_level->blocks
-	  = chainon (current_binding_level->blocks, block);
-    }
-  /* If we did not make a block for the level just exited,
-     any blocks made for inner levels
-     (since they cannot be recorded as subblocks in that level)
-     must be carried forward so they will later become subblocks
-     of something else.  */
-  else if (subblocks)
-    current_binding_level->blocks
-      = chainon (current_binding_level->blocks, subblocks);
-
-  if (block)
-    TREE_USED (block) = 1;
-  return block;
-}
-
-static void
-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);
-}
-
-/* Record a decl-node X as belonging to the current lexical scope.
-   Check for errors (such as an incompatible declaration for the same
-   name already seen in the same scope).
-
-   Returns either X or an old decl for the same name.
-   If an old decl is returned, it may have been smashed
-   to agree with what X says.  */
-
-tree
-pushdecl (tree x)
-{
-  register tree t;
-  register tree name = DECL_NAME (x);
-  register struct f_binding_level *b = current_binding_level;
-
-  if ((TREE_CODE (x) == FUNCTION_DECL)
-      && (DECL_INITIAL (x) == 0)
-      && DECL_EXTERNAL (x))
-    DECL_CONTEXT (x) = NULL_TREE;
-  else
-    DECL_CONTEXT (x) = current_function_decl;
-
-  if (name)
-    {
-      if (IDENTIFIER_INVENTED (name))
-	{
-	  DECL_ARTIFICIAL (x) = 1;
-	  DECL_IN_SYSTEM_HEADER (x) = 1;
-	}
-
-      t = lookup_name_current_level (name);
-
-      assert ((t == NULL_TREE) || (DECL_CONTEXT (x) == NULL_TREE));
-
-      /* Don't push non-parms onto list for parms until we understand
-	 why we're doing this and whether it works.  */
-
-      assert ((b == global_binding_level)
-	      || !ffecom_transform_only_dummies_
-	      || TREE_CODE (x) == PARM_DECL);
-
-      if ((t != NULL_TREE) && duplicate_decls (x, t))
-	return t;
-
-      /* If we are processing a typedef statement, generate a whole new
-	 ..._TYPE node (which will be just an variant of the existing
-	 ..._TYPE node with identical properties) and then install the
-	 TYPE_DECL node generated to represent the typedef name as the
-	 TYPE_NAME of this brand new (duplicate) ..._TYPE node.
-
-	 The whole point here is to end up with a situation where each and every
-	 ..._TYPE node the compiler creates will be uniquely associated with
-	 AT MOST one node representing a typedef name. This way, even though
-	 the compiler substitutes corresponding ..._TYPE nodes for TYPE_DECL
-	 (i.e. "typedef name") nodes very early on, later parts of the
-	 compiler can always do the reverse translation and get back the
-	 corresponding typedef name.  For example, given:
-
-	 typedef struct S MY_TYPE; MY_TYPE object;
-
-	 Later parts of the compiler might only know that `object' was of type
-	 `struct S' if it were not for code just below.  With this code
-	 however, later parts of the compiler see something like:
-
-	 struct S' == struct S typedef struct S' MY_TYPE; struct S' object;
-
-	 And they can then deduce (from the node for type struct S') that the
-	 original object declaration was:
-
-	 MY_TYPE object;
-
-	 Being able to do this is important for proper support of protoize, and
-	 also for generating precise symbolic debugging information which
-	 takes full account of the programmer's (typedef) vocabulary.
-
-	 Obviously, we don't want to generate a duplicate ..._TYPE node if the
-	 TYPE_DECL node that we are now processing really represents a
-	 standard built-in type.
-
-	 Since all standard types are effectively declared at line zero in the
-	 source file, we can easily check to see if we are working on a
-	 standard type by checking the current value of lineno.  */
-
-      if (TREE_CODE (x) == TYPE_DECL)
-	{
-	  if (DECL_SOURCE_LINE (x) == 0)
-	    {
-	      if (TYPE_NAME (TREE_TYPE (x)) == 0)
-		TYPE_NAME (TREE_TYPE (x)) = x;
-	    }
-	  else if (TREE_TYPE (x) != error_mark_node)
-	    {
-	      tree tt = TREE_TYPE (x);
-
-	      tt = build_type_copy (tt);
-	      TYPE_NAME (tt) = x;
-	      TREE_TYPE (x) = tt;
-	    }
-	}
-
-      /* This name is new in its binding level. Install the new declaration
-	 and return it.  */
-      if (b == global_binding_level)
-	IDENTIFIER_GLOBAL_VALUE (name) = x;
-      else
-	IDENTIFIER_LOCAL_VALUE (name) = x;
-    }
-
-  /* Put decls on list in reverse order. We will reverse them later if
-     necessary.  */
-  TREE_CHAIN (x) = b->names;
-  b->names = x;
-
-  return x;
-}
-
-/* Nonzero if the current level needs to have a BLOCK made.  */
-
-static int
-kept_level_p (void)
-{
-  tree decl;
-
-  for (decl = current_binding_level->names;
-       decl;
-       decl = TREE_CHAIN (decl))
-    {
-      if (TREE_USED (decl) || TREE_CODE (decl) != VAR_DECL
-	  || (DECL_NAME (decl) && ! DECL_ARTIFICIAL (decl)))
-	/* Currently, there aren't supposed to be non-artificial names
-	   at other than the top block for a function -- they're
-	   believed to always be temps.  But it's wise to check anyway.  */
-	return 1;
-    }
-  return 0;
-}
-
-/* Enter a new binding level.
-   If TAG_TRANSPARENT is nonzero, do so only for the name space of variables,
-   not for that of tags.  */
-
-void
-pushlevel (int tag_transparent)
-{
-  register struct f_binding_level *newlevel = NULL_BINDING_LEVEL;
-
-  assert (! tag_transparent);
-
-  if (current_binding_level == global_binding_level)
-    {
-      named_labels = 0;
-    }
-
-  /* Reuse or create a struct for this binding level.  */
-
-  if (free_binding_level)
-    {
-      newlevel = free_binding_level;
-      free_binding_level = free_binding_level->level_chain;
-    }
-  else
-    {
-      newlevel = make_binding_level ();
-    }
-
-  /* Add this level to the front of the chain (stack) of levels that
-     are active.  */
-
-  *newlevel = clear_binding_level;
-  newlevel->level_chain = current_binding_level;
-  current_binding_level = newlevel;
-}
-
-/* Set the BLOCK node for the innermost scope
-   (the one we are currently in).  */
-
-void
-set_block (tree block)
-{
-  current_binding_level->this_block = block;
-  current_binding_level->names = chainon (current_binding_level->names,
-					  BLOCK_VARS (block));
-  current_binding_level->blocks = chainon (current_binding_level->blocks,
-					   BLOCK_SUBBLOCKS (block));
-}
-
-static tree
-ffe_signed_or_unsigned_type (int unsignedp, tree type)
-{
-  tree type2;
-
-  if (! INTEGRAL_TYPE_P (type))
-    return type;
-  if (TYPE_PRECISION (type) == TYPE_PRECISION (signed_char_type_node))
-    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
-  if (TYPE_PRECISION (type) == TYPE_PRECISION (integer_type_node))
-    return unsignedp ? unsigned_type_node : integer_type_node;
-  if (TYPE_PRECISION (type) == TYPE_PRECISION (short_integer_type_node))
-    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
-  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_integer_type_node))
-    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
-  if (TYPE_PRECISION (type) == TYPE_PRECISION (long_long_integer_type_node))
-    return (unsignedp ? long_long_unsigned_type_node
-	    : long_long_integer_type_node);
-
-  type2 = ffe_type_for_size (TYPE_PRECISION (type), unsignedp);
-  if (type2 == NULL_TREE)
-    return type;
-
-  return type2;
-}
-
-static tree
-ffe_signed_type (tree type)
-{
-  tree type1 = TYPE_MAIN_VARIANT (type);
-  ffeinfoKindtype kt;
-  tree type2;
-
-  if (type1 == unsigned_char_type_node || type1 == char_type_node)
-    return signed_char_type_node;
-  if (type1 == unsigned_type_node)
-    return integer_type_node;
-  if (type1 == short_unsigned_type_node)
-    return short_integer_type_node;
-  if (type1 == long_unsigned_type_node)
-    return long_integer_type_node;
-  if (type1 == long_long_unsigned_type_node)
-    return long_long_integer_type_node;
-#if 0	/* gcc/c-* files only */
-  if (type1 == unsigned_intDI_type_node)
-    return intDI_type_node;
-  if (type1 == unsigned_intSI_type_node)
-    return intSI_type_node;
-  if (type1 == unsigned_intHI_type_node)
-    return intHI_type_node;
-  if (type1 == unsigned_intQI_type_node)
-    return intQI_type_node;
-#endif
-
-  type2 = ffe_type_for_size (TYPE_PRECISION (type1), 0);
-  if (type2 != NULL_TREE)
-    return type2;
-
-  for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
-    {
-      type2 = ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
-
-      if (type1 == type2)
-	return ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
-    }
-
-  return type;
-}
-
-/* Prepare expr to be an argument of a TRUTH_NOT_EXPR,
-   or validate its data type for an `if' or `while' statement or ?..: exp.
-
-   This preparation consists of taking the ordinary
-   representation of an expression expr and producing a valid tree
-   boolean expression describing whether expr is nonzero.  We could
-   simply always do build_binary_op (NE_EXPR, expr, integer_zero_node, 1),
-   but we optimize comparisons, &&, ||, and !.
-
-   The resulting type should always be `integer_type_node'.  */
-
-static tree
-ffe_truthvalue_conversion (tree expr)
-{
-  if (TREE_CODE (expr) == ERROR_MARK)
-    return expr;
-
-#if 0 /* This appears to be wrong for C++.  */
-  /* These really should return error_mark_node after 2.4 is stable.
-     But not all callers handle ERROR_MARK properly.  */
-  switch (TREE_CODE (TREE_TYPE (expr)))
-    {
-    case RECORD_TYPE:
-      error ("struct type value used where scalar is required");
-      return integer_zero_node;
-
-    case UNION_TYPE:
-      error ("union type value used where scalar is required");
-      return integer_zero_node;
-
-    case ARRAY_TYPE:
-      error ("array type value used where scalar is required");
-      return integer_zero_node;
-
-    default:
-      break;
-    }
-#endif /* 0 */
-
-  switch (TREE_CODE (expr))
-    {
-      /* It is simpler and generates better code to have only TRUTH_*_EXPR
-	 or comparison expressions as truth values at this level.  */
-#if 0
-    case COMPONENT_REF:
-      /* A one-bit unsigned bit-field is already acceptable.  */
-      if (integer_onep (DECL_SIZE (TREE_OPERAND (expr, 1)))
-	  && DECL_UNSIGNED (TREE_OPERAND (expr, 1)))
-	return expr;
-      break;
-#endif
-
-    case EQ_EXPR:
-      /* It is simpler and generates better code to have only TRUTH_*_EXPR
-	 or comparison expressions as truth values at this level.  */
-#if 0
-      if (integer_zerop (TREE_OPERAND (expr, 1)))
-	return build_unary_op (TRUTH_NOT_EXPR, TREE_OPERAND (expr, 0), 0);
-#endif
-    case NE_EXPR: case LE_EXPR: case GE_EXPR: case LT_EXPR: case GT_EXPR:
-    case TRUTH_ANDIF_EXPR:
-    case TRUTH_ORIF_EXPR:
-    case TRUTH_AND_EXPR:
-    case TRUTH_OR_EXPR:
-    case TRUTH_XOR_EXPR:
-      TREE_TYPE (expr) = integer_type_node;
-      return expr;
-
-    case ERROR_MARK:
-      return expr;
-
-    case INTEGER_CST:
-      return integer_zerop (expr) ? integer_zero_node : integer_one_node;
-
-    case REAL_CST:
-      return real_zerop (expr) ? integer_zero_node : integer_one_node;
-
-    case ADDR_EXPR:
-      if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 0)))
-	return build (COMPOUND_EXPR, integer_type_node,
-		      TREE_OPERAND (expr, 0), integer_one_node);
-      else
-	return integer_one_node;
-
-    case COMPLEX_EXPR:
-      return ffecom_2 ((TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1))
-			? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
-		       integer_type_node,
-		       ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)),
-		       ffe_truthvalue_conversion (TREE_OPERAND (expr, 1)));
-
-    case NEGATE_EXPR:
-    case ABS_EXPR:
-    case FLOAT_EXPR:
-      /* These don't change whether an object is nonzero or zero.  */
-      return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
-
-    case LROTATE_EXPR:
-    case RROTATE_EXPR:
-      /* These don't change whether an object is zero or nonzero, but
-	 we can't ignore them if their second arg has side-effects.  */
-      if (TREE_SIDE_EFFECTS (TREE_OPERAND (expr, 1)))
-	return build (COMPOUND_EXPR, integer_type_node, TREE_OPERAND (expr, 1),
-		      ffe_truthvalue_conversion (TREE_OPERAND (expr, 0)));
-      else
-	return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
-
-    case COND_EXPR:
-      {
-	/* Distribute the conversion into the arms of a COND_EXPR.  */
-	tree arg1 = TREE_OPERAND (expr, 1);
-	tree arg2 = TREE_OPERAND (expr, 2);
-	if (! VOID_TYPE_P (TREE_TYPE (arg1)))
-	  arg1 = ffe_truthvalue_conversion (arg1);
-	if (! VOID_TYPE_P (TREE_TYPE (arg2)))
-	  arg2 = ffe_truthvalue_conversion (arg2);
-	return fold (build (COND_EXPR, integer_type_node,
-			    TREE_OPERAND (expr, 0), arg1, arg2));
-      }
-
-    case CONVERT_EXPR:
-      /* Don't cancel the effect of a CONVERT_EXPR from a REFERENCE_TYPE,
-	 since that affects how `default_conversion' will behave.  */
-      if (TREE_CODE (TREE_TYPE (expr)) == REFERENCE_TYPE
-	  || TREE_CODE (TREE_TYPE (TREE_OPERAND (expr, 0))) == REFERENCE_TYPE)
-	break;
-      /* fall through... */
-    case NOP_EXPR:
-      /* If this is widening the argument, we can ignore it.  */
-      if (TYPE_PRECISION (TREE_TYPE (expr))
-	  >= TYPE_PRECISION (TREE_TYPE (TREE_OPERAND (expr, 0))))
-	return ffe_truthvalue_conversion (TREE_OPERAND (expr, 0));
-      break;
-
-    case MINUS_EXPR:
-      /* With IEEE arithmetic, x - x may not equal 0, so we can't optimize
-	 this case.  */
-      if (TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
-	  && TREE_CODE (TREE_TYPE (expr)) == REAL_TYPE)
-	break;
-      /* fall through... */
-    case BIT_XOR_EXPR:
-      /* This and MINUS_EXPR can be changed into a comparison of the
-	 two objects.  */
-      if (TREE_TYPE (TREE_OPERAND (expr, 0))
-	  == TREE_TYPE (TREE_OPERAND (expr, 1)))
-	return ffecom_2 (NE_EXPR, integer_type_node,
-			 TREE_OPERAND (expr, 0),
-			 TREE_OPERAND (expr, 1));
-      return ffecom_2 (NE_EXPR, integer_type_node,
-		       TREE_OPERAND (expr, 0),
-		       fold (build1 (NOP_EXPR,
-				     TREE_TYPE (TREE_OPERAND (expr, 0)),
-				     TREE_OPERAND (expr, 1))));
-
-    case BIT_AND_EXPR:
-      if (integer_onep (TREE_OPERAND (expr, 1)))
-	return expr;
-      break;
-
-    case MODIFY_EXPR:
-#if 0				/* No such thing in Fortran. */
-      if (warn_parentheses && C_EXP_ORIGINAL_CODE (expr) == MODIFY_EXPR)
-	warning ("suggest parentheses around assignment used as truth value");
-#endif
-      break;
-
-    default:
-      break;
-    }
-
-  if (TREE_CODE (TREE_TYPE (expr)) == COMPLEX_TYPE)
-    return (ffecom_2
-	    ((TREE_SIDE_EFFECTS (expr)
-	      ? TRUTH_OR_EXPR : TRUTH_ORIF_EXPR),
-	     integer_type_node,
-	     ffe_truthvalue_conversion (ffecom_1 (REALPART_EXPR,
-						  TREE_TYPE (TREE_TYPE (expr)),
-						  expr)),
-	     ffe_truthvalue_conversion (ffecom_1 (IMAGPART_EXPR,
-						  TREE_TYPE (TREE_TYPE (expr)),
-						  expr))));
-
-  return ffecom_2 (NE_EXPR, integer_type_node,
-		   expr,
-		   convert (TREE_TYPE (expr), integer_zero_node));
-}
-
-static tree
-ffe_type_for_mode (enum machine_mode mode, int unsignedp)
-{
-  int i;
-  int j;
-  tree t;
-
-  if (mode == TYPE_MODE (integer_type_node))
-    return unsignedp ? unsigned_type_node : integer_type_node;
-
-  if (mode == TYPE_MODE (signed_char_type_node))
-    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
-
-  if (mode == TYPE_MODE (short_integer_type_node))
-    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
-
-  if (mode == TYPE_MODE (long_integer_type_node))
-    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
-
-  if (mode == TYPE_MODE (long_long_integer_type_node))
-    return unsignedp ? long_long_unsigned_type_node : long_long_integer_type_node;
-
-#if HOST_BITS_PER_WIDE_INT >= 64
-  if (mode == TYPE_MODE (intTI_type_node))
-    return unsignedp ? unsigned_intTI_type_node : intTI_type_node;
-#endif
-
-  if (mode == TYPE_MODE (float_type_node))
-    return float_type_node;
-
-  if (mode == TYPE_MODE (double_type_node))
-    return double_type_node;
-
-  if (mode == TYPE_MODE (long_double_type_node))
-    return long_double_type_node;
-
- if (mode == TYPE_MODE (build_pointer_type (char_type_node)))
-    return build_pointer_type (char_type_node);
-
-  if (mode == TYPE_MODE (build_pointer_type (integer_type_node)))
-    return build_pointer_type (integer_type_node);
-
-  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)
-      {
-	if (((t = ffecom_tree_type[i][j]) != NULL_TREE)
-	    && (mode == TYPE_MODE (t)))
-	  {
-	    if ((i == FFEINFO_basictypeINTEGER) && unsignedp)
-	      return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][j];
-	    else
-	      return t;
-	  }
-      }
-
-  return 0;
-}
-
-static tree
-ffe_type_for_size (unsigned bits, int unsignedp)
-{
-  ffeinfoKindtype kt;
-  tree type_node;
-
-  if (bits == TYPE_PRECISION (integer_type_node))
-    return unsignedp ? unsigned_type_node : integer_type_node;
-
-  if (bits == TYPE_PRECISION (signed_char_type_node))
-    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
-
-  if (bits == TYPE_PRECISION (short_integer_type_node))
-    return unsignedp ? short_unsigned_type_node : short_integer_type_node;
-
-  if (bits == TYPE_PRECISION (long_integer_type_node))
-    return unsignedp ? long_unsigned_type_node : long_integer_type_node;
-
-  if (bits == TYPE_PRECISION (long_long_integer_type_node))
-    return (unsignedp ? long_long_unsigned_type_node
-	    : long_long_integer_type_node);
-
-  for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
-    {
-      type_node = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
-
-      if ((type_node != NULL_TREE) && (bits == TYPE_PRECISION (type_node)))
-	return unsignedp ? ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt]
-	  : type_node;
-    }
-
-  return 0;
-}
-
-static tree
-ffe_unsigned_type (tree type)
-{
-  tree type1 = TYPE_MAIN_VARIANT (type);
-  ffeinfoKindtype kt;
-  tree type2;
-
-  if (type1 == signed_char_type_node || type1 == char_type_node)
-    return unsigned_char_type_node;
-  if (type1 == integer_type_node)
-    return unsigned_type_node;
-  if (type1 == short_integer_type_node)
-    return short_unsigned_type_node;
-  if (type1 == long_integer_type_node)
-    return long_unsigned_type_node;
-  if (type1 == long_long_integer_type_node)
-    return long_long_unsigned_type_node;
-#if 0	/* gcc/c-* files only */
-  if (type1 == intDI_type_node)
-    return unsigned_intDI_type_node;
-  if (type1 == intSI_type_node)
-    return unsigned_intSI_type_node;
-  if (type1 == intHI_type_node)
-    return unsigned_intHI_type_node;
-  if (type1 == intQI_type_node)
-    return unsigned_intQI_type_node;
-#endif
-
-  type2 = ffe_type_for_size (TYPE_PRECISION (type1), 1);
-  if (type2 != NULL_TREE)
-    return type2;
-
-  for (kt = 0; kt < ARRAY_SIZE (ffecom_tree_type[0]); ++kt)
-    {
-      type2 = ffecom_tree_type[FFEINFO_basictypeINTEGER][kt];
-
-      if (type1 == type2)
-	return ffecom_tree_type[FFEINFO_basictypeHOLLERITH][kt];
-    }
-
-  return type;
-}
-
-/* From gcc/cccp.c, the code to handle -I.  */
-
-/* Skip leading "./" from a directory name.
-   This may yield the empty string, which represents the current directory.  */
-
-static const char *
-skip_redundant_dir_prefix (const char *dir)
-{
-  while (dir[0] == '.' && dir[1] == '/')
-    for (dir += 2; *dir == '/'; dir++)
-      continue;
-  if (dir[0] == '.' && !dir[1])
-    dir++;
-  return dir;
-}
-
-/* The file_name_map structure holds a mapping of file names for a
-   particular directory.  This mapping is read from the file named
-   FILE_NAME_MAP_FILE in that directory.  Such a file can be used to
-   map filenames on a file system with severe filename restrictions,
-   such as DOS.  The format of the file name map file is just a series
-   of lines with two tokens on each line.  The first token is the name
-   to map, and the second token is the actual name to use.  */
-
-struct file_name_map
-{
-  struct file_name_map *map_next;
-  char *map_from;
-  char *map_to;
-};
-
-#define FILE_NAME_MAP_FILE "header.gcc"
-
-/* Current maximum length of directory names in the search path
-   for include files.  (Altered as we get more of them.)  */
-
-static int max_include_len = 0;
-
-struct file_name_list
-  {
-    struct file_name_list *next;
-    const char *fname;
-    /* Mapping of file names for this directory.  */
-    struct file_name_map *name_map;
-    /* Nonzero if name_map is valid.  */
-    int got_name_map;
-  };
-
-static struct file_name_list *include = NULL;	/* First dir to search */
-static struct file_name_list *last_include = NULL;	/* Last in chain */
-
-/* I/O buffer structure.
-   The `fname' field is nonzero for source files and #include files
-   and for the dummy text used for -D and -U.
-   It is zero for rescanning results of macro expansion
-   and for expanding macro arguments.  */
-#define INPUT_STACK_MAX 400
-static struct file_buf {
-  const char *fname;
-  /* Filename specified with #line command.  */
-  const char *nominal_fname;
-  /* Record where in the search path this file was found.
-     For #include_next.  */
-  struct file_name_list *dir;
-  ffewhereLine line;
-  ffewhereColumn column;
-} instack[INPUT_STACK_MAX];
-
-static int last_error_tick = 0;	   /* Incremented each time we print it.  */
-
-/* Current nesting level of input sources.
-   `instack[indepth]' is the level currently being read.  */
-static int indepth = -1;
-
-typedef struct file_buf FILE_BUF;
-
-/* Nonzero means -I- has been seen,
-   so don't look for #include "foo" the source-file directory.  */
-static int ignore_srcdir;
-
-#ifndef INCLUDE_LEN_FUDGE
-#define INCLUDE_LEN_FUDGE 0
-#endif
-
-static void append_include_chain (struct file_name_list *first,
-				  struct file_name_list *last);
-static FILE *open_include_file (char *filename,
-				struct file_name_list *searchptr);
-static void print_containing_files (ffebadSeverity sev);
-static char *read_filename_string (int ch, FILE *f);
-static struct file_name_map *read_name_map (const char *dirname);
-
-/* Append a chain of `struct file_name_list's
-   to the end of the main include chain.
-   FIRST is the beginning of the chain to append, and LAST is the end.  */
-
-static void
-append_include_chain (struct file_name_list *first,
-		      struct file_name_list *last)
-{
-  struct file_name_list *dir;
-
-  if (!first || !last)
-    return;
-
-  if (include == 0)
-    include = first;
-  else
-    last_include->next = first;
-
-  for (dir = first; ; dir = dir->next) {
-    int len = strlen (dir->fname) + INCLUDE_LEN_FUDGE;
-    if (len > max_include_len)
-      max_include_len = len;
-    if (dir == last)
-      break;
-  }
-
-  last->next = NULL;
-  last_include = last;
-}
-
-/* Try to open include file FILENAME.  SEARCHPTR is the directory
-   being tried from the include file search path.  This function maps
-   filenames on file systems based on information read by
-   read_name_map.  */
-
-static FILE *
-open_include_file (char *filename, struct file_name_list *searchptr)
-{
-  register struct file_name_map *map;
-  register char *from;
-  char *p, *dir;
-
-  if (searchptr && ! searchptr->got_name_map)
-    {
-      searchptr->name_map = read_name_map (searchptr->fname
-					   ? searchptr->fname : ".");
-      searchptr->got_name_map = 1;
-    }
-
-  /* First check the mapping for the directory we are using.  */
-  if (searchptr && searchptr->name_map)
-    {
-      from = filename;
-      if (searchptr->fname)
-	from += strlen (searchptr->fname) + 1;
-      for (map = searchptr->name_map; map; map = map->map_next)
-	{
-	  if (! strcmp (map->map_from, from))
-	    {
-	      /* Found a match.  */
-	      return fopen (map->map_to, "r");
-	    }
-	}
-    }
-
-  /* Try to find a mapping file for the particular directory we are
-     looking in.  Thus #include <sys/types.h> will look up sys/types.h
-     in /usr/include/header.gcc and look up types.h in
-     /usr/include/sys/header.gcc.  */
-  p = strrchr (filename, '/');
-#ifdef DIR_SEPARATOR
-  if (! p) p = strrchr (filename, DIR_SEPARATOR);
-  else {
-    char *tmp = strrchr (filename, DIR_SEPARATOR);
-    if (tmp != NULL && tmp > p) p = tmp;
-  }
-#endif
-  if (! p)
-    p = filename;
-  if (searchptr
-      && searchptr->fname
-      && strlen (searchptr->fname) == (size_t) (p - filename)
-      && ! strncmp (searchptr->fname, filename, (int) (p - filename)))
-    {
-      /* FILENAME is in SEARCHPTR, which we've already checked.  */
-      return fopen (filename, "r");
-    }
-
-  if (p == filename)
-    {
-      from = filename;
-      map = read_name_map (".");
-    }
-  else
-    {
-      dir = xmalloc (p - filename + 1);
-      memcpy (dir, filename, p - filename);
-      dir[p - filename] = '\0';
-      from = p + 1;
-      map = read_name_map (dir);
-      free (dir);
-    }
-  for (; map; map = map->map_next)
-    if (! strcmp (map->map_from, from))
-      return fopen (map->map_to, "r");
-
-  return fopen (filename, "r");
-}
-
-/* Print the file names and line numbers of the #include
-   commands which led to the current file.  */
-
-static void
-print_containing_files (ffebadSeverity sev)
-{
-  FILE_BUF *ip = NULL;
-  int i;
-  int first = 1;
-  const char *str1;
-  const char *str2;
-
-  /* If stack of files hasn't changed since we last printed
-     this info, don't repeat it.  */
-  if (last_error_tick == input_file_stack_tick)
-    return;
-
-  for (i = indepth; i >= 0; i--)
-    if (instack[i].fname != NULL) {
-      ip = &instack[i];
-      break;
-    }
-
-  /* Give up if we don't find a source file.  */
-  if (ip == NULL)
-    return;
-
-  /* Find the other, outer source files.  */
-  for (i--; i >= 0; i--)
-    if (instack[i].fname != NULL)
-      {
-	ip = &instack[i];
-	if (first)
-	  {
-	    first = 0;
-	    str1 = "In file included";
-	  }
-	else
-	  {
-	    str1 = "...          ...";
-	  }
-
-	if (i == 1)
-	  str2 = ":";
-	else
-	  str2 = "";
-
-	/* xgettext:no-c-format */
-	ffebad_start_msg ("%A from %B at %0%C", sev);
-	ffebad_here (0, ip->line, ip->column);
-	ffebad_string (str1);
-	ffebad_string (ip->nominal_fname);
-	ffebad_string (str2);
-	ffebad_finish ();
-      }
-
-  /* Record we have printed the status as of this time.  */
-  last_error_tick = input_file_stack_tick;
-}
-
-/* Read a space delimited string of unlimited length from a stdio
-   file.  */
-
-static char *
-read_filename_string (int ch, FILE *f)
-{
-  char *alloc, *set;
-  int len;
-
-  len = 20;
-  set = alloc = xmalloc (len + 1);
-  if (! ISSPACE (ch))
-    {
-      *set++ = ch;
-      while ((ch = getc (f)) != EOF && ! ISSPACE (ch))
-	{
-	  if (set - alloc == len)
-	    {
-	      len *= 2;
-	      alloc = xrealloc (alloc, len + 1);
-	      set = alloc + len / 2;
-	    }
-	  *set++ = ch;
-	}
-    }
-  *set = '\0';
-  ungetc (ch, f);
-  return alloc;
-}
-
-/* Read the file name map file for DIRNAME.  */
-
-static struct file_name_map *
-read_name_map (const char *dirname)
-{
-  /* This structure holds a linked list of file name maps, one per
-     directory.  */
-  struct file_name_map_list
-    {
-      struct file_name_map_list *map_list_next;
-      char *map_list_name;
-      struct file_name_map *map_list_map;
-    };
-  static struct file_name_map_list *map_list;
-  register struct file_name_map_list *map_list_ptr;
-  char *name;
-  FILE *f;
-  size_t dirlen;
-  int separator_needed;
-
-  dirname = skip_redundant_dir_prefix (dirname);
-
-  for (map_list_ptr = map_list; map_list_ptr;
-       map_list_ptr = map_list_ptr->map_list_next)
-    if (! strcmp (map_list_ptr->map_list_name, dirname))
-      return map_list_ptr->map_list_map;
-
-  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;
-
-  dirlen = strlen (dirname);
-  separator_needed = dirlen != 0 && dirname[dirlen - 1] != '/';
-  if (separator_needed)
-    name = concat (dirname, "/", FILE_NAME_MAP_FILE, NULL);
-  else
-    name = concat (dirname, FILE_NAME_MAP_FILE, NULL);
-  f = fopen (name, "r");
-  free (name);
-  if (!f)
-    map_list_ptr->map_list_map = NULL;
-  else
-    {
-      int ch;
-
-      while ((ch = getc (f)) != EOF)
-	{
-	  char *from, *to;
-	  struct file_name_map *ptr;
-
-	  if (ISSPACE (ch))
-	    continue;
-	  from = read_filename_string (ch, f);
-	  while ((ch = getc (f)) != EOF && ISSPACE (ch) && ch != '\n')
-	    ;
-	  to = read_filename_string (ch, f);
-
-	  ptr = xmalloc (sizeof (struct file_name_map));
-	  ptr->map_from = from;
-
-	  /* Make the real filename absolute.  */
-	  if (*to == '/')
-	    ptr->map_to = to;
-	  else
-	    {
-	      if (separator_needed)
-		ptr->map_to = concat (dirname, "/", to, NULL);
-	      else
-		ptr->map_to = concat (dirname, to, NULL);
-	      free (to);
-	    }
-
-	  ptr->map_next = map_list_ptr->map_list_map;
-	  map_list_ptr->map_list_map = ptr;
-
-	  while ((ch = getc (f)) != '\n')
-	    if (ch == EOF)
-	      break;
-	}
-      fclose (f);
-    }
-
-  map_list_ptr->map_list_next = map_list;
-  map_list = map_list_ptr;
-
-  return map_list_ptr->map_list_map;
-}
-
-static void
-ffecom_file_ (const char *name)
-{
-  FILE_BUF *fp;
-
-  /* Do partial setup of input buffer for the sake of generating
-     early #line directives (when -g is in effect).  */
-
-  fp = &instack[++indepth];
-  memset (fp, 0, sizeof (FILE_BUF));
-  if (name == NULL)
-    name = "";
-  fp->nominal_fname = fp->fname = name;
-}
-
-static void
-ffecom_close_include_ (FILE *f)
-{
-  fclose (f);
-
-  indepth--;
-  input_file_stack_tick++;
-
-  ffewhere_line_kill (instack[indepth].line);
-  ffewhere_column_kill (instack[indepth].column);
-}
-
-void
-ffecom_decode_include_option (const char *dir)
-{
-  if (! ignore_srcdir && !strcmp (dir, "-"))
-    ignore_srcdir = 1;
-  else
-    {
-      struct file_name_list *dirtmp
-	= xmalloc (sizeof (struct file_name_list));
-      dirtmp->next = 0;		/* New one goes on the end */
-      dirtmp->fname = dir;
-      dirtmp->got_name_map = 0;
-      append_include_chain (dirtmp, dirtmp);
-    }
-}
-
-/* Open INCLUDEd file.  */
-
-static FILE *
-ffecom_open_include_ (char *name, ffewhereLine l, ffewhereColumn c)
-{
-  char *fbeg = name;
-  size_t flen = strlen (fbeg);
-  struct file_name_list *search_start = include; /* Chain of dirs to search */
-  struct file_name_list dsp[1];	/* First in chain, if #include "..." */
-  struct file_name_list *searchptr = 0;
-  char *fname;		/* Dynamically allocated fname buffer */
-  FILE *f;
-  FILE_BUF *fp;
-
-  if (flen == 0)
-    return NULL;
-
-  dsp[0].fname = NULL;
-
-  /* If -I- was specified, don't search current dir, only spec'd ones. */
-  if (!ignore_srcdir)
-    {
-      for (fp = &instack[indepth]; fp >= instack; fp--)
-	{
-	  int n;
-	  char *ep;
-	  const char *nam;
-
-	  if ((nam = fp->nominal_fname) != NULL)
-	    {
-	      /* Found a named file.  Figure out dir of the file,
-		 and put it in front of the search list.  */
-	      dsp[0].next = search_start;
-	      search_start = dsp;
-#ifndef VMS
-	      ep = strrchr (nam, '/');
-#ifdef DIR_SEPARATOR
-	    if (ep == NULL) ep = strrchr (nam, DIR_SEPARATOR);
-	    else {
-	      char *tmp = strrchr (nam, DIR_SEPARATOR);
-	      if (tmp != NULL && tmp > ep) ep = tmp;
-	    }
-#endif
-#else				/* VMS */
-	      ep = strrchr (nam, ']');
-	      if (ep == NULL) ep = strrchr (nam, '>');
-	      if (ep == NULL) ep = strrchr (nam, ':');
-	      if (ep != NULL) ep++;
-#endif				/* VMS */
-	      if (ep != NULL)
-		{
-		  n = ep - nam;
-		  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;
-		}
-	      else
-		dsp[0].fname = NULL; /* Current directory */
-	      dsp[0].got_name_map = 0;
-	      break;
-	    }
-	}
-    }
-
-  /* Allocate this permanently, because it gets stored in the definitions
-     of macros.  */
-  fname = xmalloc (max_include_len + flen + 4);
-  /* + 2 above for slash and terminating null.  */
-  /* + 2 added for '.h' on VMS (to support '#include filename') (NOT USED
-     for g77 yet).  */
-
-  /* If specified file name is absolute, just open it.  */
-
-  if (*fbeg == '/'
-#ifdef DIR_SEPARATOR
-      || *fbeg == DIR_SEPARATOR
-#endif
-      )
-    {
-      strncpy (fname, (char *) fbeg, flen);
-      fname[flen] = 0;
-      f = open_include_file (fname, NULL);
-    }
-  else
-    {
-      f = NULL;
-
-      /* Search directory path, trying to open the file.
-	 Copy each filename tried into FNAME.  */
-
-      for (searchptr = search_start; searchptr; searchptr = searchptr->next)
-	{
-	  if (searchptr->fname)
-	    {
-	      /* The empty string in a search path is ignored.
-		 This makes it possible to turn off entirely
-		 a standard piece of the list.  */
-	      if (searchptr->fname[0] == 0)
-		continue;
-	      strcpy (fname, skip_redundant_dir_prefix (searchptr->fname));
-	      if (fname[0] && fname[strlen (fname) - 1] != '/')
-		strcat (fname, "/");
-	      fname[strlen (fname) + flen] = 0;
-	    }
-	  else
-	    fname[0] = 0;
-
-	  strncat (fname, fbeg, flen);
-#ifdef VMS
-	  /* Change this 1/2 Unix 1/2 VMS file specification into a
-	     full VMS file specification */
-	  if (searchptr->fname && (searchptr->fname[0] != 0))
-	    {
-	      /* Fix up the filename */
-	      hack_vms_include_specification (fname);
-	    }
-	  else
-	    {
-	      /* This is a normal VMS filespec, so use it unchanged.  */
-	      strncpy (fname, (char *) fbeg, flen);
-	      fname[flen] = 0;
-#if 0	/* Not for g77.  */
-	      /* if it's '#include filename', add the missing .h */
-	      if (strchr (fname, '.') == NULL)
-		strcat (fname, ".h");
-#endif
-	    }
-#endif /* VMS */
-	  f = open_include_file (fname, searchptr);
-#ifdef EACCES
-	  if (f == NULL && errno == EACCES)
-	    {
-	      print_containing_files (FFEBAD_severityWARNING);
-	      /* xgettext:no-c-format */
-	      ffebad_start_msg ("At %0, INCLUDE file %A exists, but is not readable",
-				FFEBAD_severityWARNING);
-	      ffebad_string (fname);
-	      ffebad_here (0, l, c);
-	      ffebad_finish ();
-	    }
-#endif
-	  if (f != NULL)
-	    break;
-	}
-    }
-
-  if (f == NULL)
-    {
-      /* A file that was not found.  */
-
-      strncpy (fname, (char *) fbeg, flen);
-      fname[flen] = 0;
-      print_containing_files (ffebad_severity (FFEBAD_OPEN_INCLUDE));
-      ffebad_start (FFEBAD_OPEN_INCLUDE);
-      ffebad_here (0, l, c);
-      ffebad_string (fname);
-      ffebad_finish ();
-    }
-
-  if (dsp[0].fname != NULL)
-    free ((char *) dsp[0].fname);
-
-  if (f == NULL)
-    return NULL;
-
-  if (indepth >= (INPUT_STACK_MAX - 1))
-    {
-      print_containing_files (FFEBAD_severityFATAL);
-      /* xgettext:no-c-format */
-      ffebad_start_msg ("At %0, INCLUDE nesting too deep",
-			FFEBAD_severityFATAL);
-      ffebad_string (fname);
-      ffebad_here (0, l, c);
-      ffebad_finish ();
-      return NULL;
-    }
-
-  instack[indepth].line = ffewhere_line_use (l);
-  instack[indepth].column = ffewhere_column_use (c);
-
-  fp = &instack[indepth + 1];
-  memset (fp, 0, sizeof (FILE_BUF));
-  fp->nominal_fname = fp->fname = fname;
-  fp->dir = searchptr;
-
-  indepth++;
-  input_file_stack_tick++;
-
-  return f;
-}
-
-/**INDENT* (Do not reformat this comment even with -fca option.)
-   Data-gathering files: Given the source file listed below, compiled with
-   f2c I obtained the output file listed after that, and from the output
-   file I derived the above code.
-
--------- (begin input file to f2c)
-	implicit none
-	character*10 A1,A2
-	complex C1,C2
-	integer I1,I2
-	real R1,R2
-	double precision D1,D2
-C
-	call getem(A1,A2,C1,C2,I1,I2,R1,R2,D1,D2)
-c /
-	call fooI(I1/I2)
-	call fooR(R1/I1)
-	call fooD(D1/I1)
-	call fooC(C1/I1)
-	call fooR(R1/R2)
-	call fooD(R1/D1)
-	call fooD(D1/D2)
-	call fooD(D1/R1)
-	call fooC(C1/C2)
-	call fooC(C1/R1)
-	call fooZ(C1/D1)
-c **
-	call fooI(I1**I2)
-	call fooR(R1**I1)
-	call fooD(D1**I1)
-	call fooC(C1**I1)
-	call fooR(R1**R2)
-	call fooD(R1**D1)
-	call fooD(D1**D2)
-	call fooD(D1**R1)
-	call fooC(C1**C2)
-	call fooC(C1**R1)
-	call fooZ(C1**D1)
-c FFEINTRIN_impABS
-	call fooR(ABS(R1))
-c FFEINTRIN_impACOS
-	call fooR(ACOS(R1))
-c FFEINTRIN_impAIMAG
-	call fooR(AIMAG(C1))
-c FFEINTRIN_impAINT
-	call fooR(AINT(R1))
-c FFEINTRIN_impALOG
-	call fooR(ALOG(R1))
-c FFEINTRIN_impALOG10
-	call fooR(ALOG10(R1))
-c FFEINTRIN_impAMAX0
-	call fooR(AMAX0(I1,I2))
-c FFEINTRIN_impAMAX1
-	call fooR(AMAX1(R1,R2))
-c FFEINTRIN_impAMIN0
-	call fooR(AMIN0(I1,I2))
-c FFEINTRIN_impAMIN1
-	call fooR(AMIN1(R1,R2))
-c FFEINTRIN_impAMOD
-	call fooR(AMOD(R1,R2))
-c FFEINTRIN_impANINT
-	call fooR(ANINT(R1))
-c FFEINTRIN_impASIN
-	call fooR(ASIN(R1))
-c FFEINTRIN_impATAN
-	call fooR(ATAN(R1))
-c FFEINTRIN_impATAN2
-	call fooR(ATAN2(R1,R2))
-c FFEINTRIN_impCABS
-	call fooR(CABS(C1))
-c FFEINTRIN_impCCOS
-	call fooC(CCOS(C1))
-c FFEINTRIN_impCEXP
-	call fooC(CEXP(C1))
-c FFEINTRIN_impCHAR
-	call fooA(CHAR(I1))
-c FFEINTRIN_impCLOG
-	call fooC(CLOG(C1))
-c FFEINTRIN_impCONJG
-	call fooC(CONJG(C1))
-c FFEINTRIN_impCOS
-	call fooR(COS(R1))
-c FFEINTRIN_impCOSH
-	call fooR(COSH(R1))
-c FFEINTRIN_impCSIN
-	call fooC(CSIN(C1))
-c FFEINTRIN_impCSQRT
-	call fooC(CSQRT(C1))
-c FFEINTRIN_impDABS
-	call fooD(DABS(D1))
-c FFEINTRIN_impDACOS
-	call fooD(DACOS(D1))
-c FFEINTRIN_impDASIN
-	call fooD(DASIN(D1))
-c FFEINTRIN_impDATAN
-	call fooD(DATAN(D1))
-c FFEINTRIN_impDATAN2
-	call fooD(DATAN2(D1,D2))
-c FFEINTRIN_impDCOS
-	call fooD(DCOS(D1))
-c FFEINTRIN_impDCOSH
-	call fooD(DCOSH(D1))
-c FFEINTRIN_impDDIM
-	call fooD(DDIM(D1,D2))
-c FFEINTRIN_impDEXP
-	call fooD(DEXP(D1))
-c FFEINTRIN_impDIM
-	call fooR(DIM(R1,R2))
-c FFEINTRIN_impDINT
-	call fooD(DINT(D1))
-c FFEINTRIN_impDLOG
-	call fooD(DLOG(D1))
-c FFEINTRIN_impDLOG10
-	call fooD(DLOG10(D1))
-c FFEINTRIN_impDMAX1
-	call fooD(DMAX1(D1,D2))
-c FFEINTRIN_impDMIN1
-	call fooD(DMIN1(D1,D2))
-c FFEINTRIN_impDMOD
-	call fooD(DMOD(D1,D2))
-c FFEINTRIN_impDNINT
-	call fooD(DNINT(D1))
-c FFEINTRIN_impDPROD
-	call fooD(DPROD(R1,R2))
-c FFEINTRIN_impDSIGN
-	call fooD(DSIGN(D1,D2))
-c FFEINTRIN_impDSIN
-	call fooD(DSIN(D1))
-c FFEINTRIN_impDSINH
-	call fooD(DSINH(D1))
-c FFEINTRIN_impDSQRT
-	call fooD(DSQRT(D1))
-c FFEINTRIN_impDTAN
-	call fooD(DTAN(D1))
-c FFEINTRIN_impDTANH
-	call fooD(DTANH(D1))
-c FFEINTRIN_impEXP
-	call fooR(EXP(R1))
-c FFEINTRIN_impIABS
-	call fooI(IABS(I1))
-c FFEINTRIN_impICHAR
-	call fooI(ICHAR(A1))
-c FFEINTRIN_impIDIM
-	call fooI(IDIM(I1,I2))
-c FFEINTRIN_impIDNINT
-	call fooI(IDNINT(D1))
-c FFEINTRIN_impINDEX
-	call fooI(INDEX(A1,A2))
-c FFEINTRIN_impISIGN
-	call fooI(ISIGN(I1,I2))
-c FFEINTRIN_impLEN
-	call fooI(LEN(A1))
-c FFEINTRIN_impLGE
-	call fooL(LGE(A1,A2))
-c FFEINTRIN_impLGT
-	call fooL(LGT(A1,A2))
-c FFEINTRIN_impLLE
-	call fooL(LLE(A1,A2))
-c FFEINTRIN_impLLT
-	call fooL(LLT(A1,A2))
-c FFEINTRIN_impMAX0
-	call fooI(MAX0(I1,I2))
-c FFEINTRIN_impMAX1
-	call fooI(MAX1(R1,R2))
-c FFEINTRIN_impMIN0
-	call fooI(MIN0(I1,I2))
-c FFEINTRIN_impMIN1
-	call fooI(MIN1(R1,R2))
-c FFEINTRIN_impMOD
-	call fooI(MOD(I1,I2))
-c FFEINTRIN_impNINT
-	call fooI(NINT(R1))
-c FFEINTRIN_impSIGN
-	call fooR(SIGN(R1,R2))
-c FFEINTRIN_impSIN
-	call fooR(SIN(R1))
-c FFEINTRIN_impSINH
-	call fooR(SINH(R1))
-c FFEINTRIN_impSQRT
-	call fooR(SQRT(R1))
-c FFEINTRIN_impTAN
-	call fooR(TAN(R1))
-c FFEINTRIN_impTANH
-	call fooR(TANH(R1))
-c FFEINTRIN_imp_CMPLX_C
-	call fooC(cmplx(C1,C2))
-c FFEINTRIN_imp_CMPLX_D
-	call fooZ(cmplx(D1,D2))
-c FFEINTRIN_imp_CMPLX_I
-	call fooC(cmplx(I1,I2))
-c FFEINTRIN_imp_CMPLX_R
-	call fooC(cmplx(R1,R2))
-c FFEINTRIN_imp_DBLE_C
-	call fooD(dble(C1))
-c FFEINTRIN_imp_DBLE_D
-	call fooD(dble(D1))
-c FFEINTRIN_imp_DBLE_I
-	call fooD(dble(I1))
-c FFEINTRIN_imp_DBLE_R
-	call fooD(dble(R1))
-c FFEINTRIN_imp_INT_C
-	call fooI(int(C1))
-c FFEINTRIN_imp_INT_D
-	call fooI(int(D1))
-c FFEINTRIN_imp_INT_I
-	call fooI(int(I1))
-c FFEINTRIN_imp_INT_R
-	call fooI(int(R1))
-c FFEINTRIN_imp_REAL_C
-	call fooR(real(C1))
-c FFEINTRIN_imp_REAL_D
-	call fooR(real(D1))
-c FFEINTRIN_imp_REAL_I
-	call fooR(real(I1))
-c FFEINTRIN_imp_REAL_R
-	call fooR(real(R1))
-c
-c FFEINTRIN_imp_INT_D:
-c
-c FFEINTRIN_specIDINT
-	call fooI(IDINT(D1))
-c
-c FFEINTRIN_imp_INT_R:
-c
-c FFEINTRIN_specIFIX
-	call fooI(IFIX(R1))
-c FFEINTRIN_specINT
-	call fooI(INT(R1))
-c
-c FFEINTRIN_imp_REAL_D:
-c
-c FFEINTRIN_specSNGL
-	call fooR(SNGL(D1))
-c
-c FFEINTRIN_imp_REAL_I:
-c
-c FFEINTRIN_specFLOAT
-	call fooR(FLOAT(I1))
-c FFEINTRIN_specREAL
-	call fooR(REAL(I1))
-c
-	end
--------- (end input file to f2c)
-
--------- (begin output from providing above input file as input to:
---------  `f2c | gcc -E -C - | sed -e "s:/[*]*://:g" -e "s:[*]*[/]://:g" \
---------     -e "s:^#.*$::g"')
-
-//  -- translated by f2c (version 19950223).
-   You must link the resulting object file with the libraries:
-        -lf2c -lm   (in that order)
-//
-
-
-// f2c.h  --  Standard Fortran to C header file //
-
-///  barf  [ba:rf]  2.  "He suggested using FORTRAN, and everybody barfed."
-
-        - From The Shogakukan DICTIONARY OF NEW ENGLISH (Second edition) //
-
-
-
-
-// F2C_INTEGER will normally be `int' but would be `long' on 16-bit systems //
-// we assume short, float are OK //
-typedef long int // long int // integer;
-typedef char *address;
-typedef short int shortint;
-typedef float real;
-typedef double doublereal;
-typedef struct { real r, i; } complex;
-typedef struct { doublereal r, i; } doublecomplex;
-typedef long int // long int // logical;
-typedef short int shortlogical;
-typedef char logical1;
-typedef char integer1;
-// typedef long long longint; // // system-dependent //
-
-
-
-
-// Extern is for use with -E //
-
-
-
-
-// I/O stuff //
-
-
-
-
-
-
-
-
-typedef long int // int or long int // flag;
-typedef long int // int or long int // ftnlen;
-typedef long int // int or long int // ftnint;
-
-
-//external read, write//
-typedef struct
-{       flag cierr;
-        ftnint ciunit;
-        flag ciend;
-        char *cifmt;
-        ftnint cirec;
-} cilist;
-
-//internal read, write//
-typedef struct
-{       flag icierr;
-        char *iciunit;
-        flag iciend;
-        char *icifmt;
-        ftnint icirlen;
-        ftnint icirnum;
-} icilist;
-
-//open//
-typedef struct
-{       flag oerr;
-        ftnint ounit;
-        char *ofnm;
-        ftnlen ofnmlen;
-        char *osta;
-        char *oacc;
-        char *ofm;
-        ftnint orl;
-        char *oblnk;
-} olist;
-
-//close//
-typedef struct
-{       flag cerr;
-        ftnint cunit;
-        char *csta;
-} cllist;
-
-//rewind, backspace, endfile//
-typedef struct
-{       flag aerr;
-        ftnint aunit;
-} alist;
-
-// inquire //
-typedef struct
-{       flag inerr;
-        ftnint inunit;
-        char *infile;
-        ftnlen infilen;
-        ftnint  *inex;  //parameters in standard's order//
-        ftnint  *inopen;
-        ftnint  *innum;
-        ftnint  *innamed;
-        char    *inname;
-        ftnlen  innamlen;
-        char    *inacc;
-        ftnlen  inacclen;
-        char    *inseq;
-        ftnlen  inseqlen;
-        char    *indir;
-        ftnlen  indirlen;
-        char    *infmt;
-        ftnlen  infmtlen;
-        char    *inform;
-        ftnint  informlen;
-        char    *inunf;
-        ftnlen  inunflen;
-        ftnint  *inrecl;
-        ftnint  *innrec;
-        char    *inblank;
-        ftnlen  inblanklen;
-} inlist;
-
-
-
-union Multitype {       // for multiple entry points //
-        integer1 g;
-        shortint h;
-        integer i;
-        // longint j; //
-        real r;
-        doublereal d;
-        complex c;
-        doublecomplex z;
-        };
-
-typedef union Multitype Multitype;
-
-typedef long Long;      // No longer used; formerly in Namelist //
-
-struct Vardesc {        // for Namelist //
-        char *name;
-        char *addr;
-        ftnlen *dims;
-        int  type;
-        };
-typedef struct Vardesc Vardesc;
-
-struct Namelist {
-        char *name;
-        Vardesc **vars;
-        int nvars;
-        };
-typedef struct Namelist Namelist;
-
-
-
-
-
-
-
-
-// procedure parameter types for -A and -C++ //
-
-
-
-
-typedef int // Unknown procedure type // (*U_fp)();
-typedef shortint (*J_fp)();
-typedef integer (*I_fp)();
-typedef real (*R_fp)();
-typedef doublereal (*D_fp)(), (*E_fp)();
-typedef // Complex // void  (*C_fp)();
-typedef // Double Complex // void  (*Z_fp)();
-typedef logical (*L_fp)();
-typedef shortlogical (*K_fp)();
-typedef // Character // void  (*H_fp)();
-typedef // Subroutine // int (*S_fp)();
-
-// E_fp is for real functions when -R is not specified //
-typedef void  C_f;      // complex function //
-typedef void  H_f;      // character function //
-typedef void  Z_f;      // double complex function //
-typedef doublereal E_f; // real function with -R not specified //
-
-// undef any lower-case symbols that your C compiler predefines, e.g.: //
-
-
-// (No such symbols should be defined in a strict ANSI C compiler.
-   We can avoid trouble with f2c-translated code by using
-   gcc -ansi.) //
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-// Main program // MAIN__()
-{
-    // System generated locals //
-    integer i__1;
-    real r__1, r__2;
-    doublereal d__1, d__2;
-    complex q__1;
-    doublecomplex z__1, z__2, z__3;
-    logical L__1;
-    char ch__1[1];
-
-    // Builtin functions //
-    void c_div();
-    integer pow_ii();
-    double pow_ri(), pow_di();
-    void pow_ci();
-    double pow_dd();
-    void pow_zz();
-    double acos(), r_imag(), r_int(), log(), r_lg10(), r_mod(), r_nint(),
-            asin(), atan(), atan2(), c_abs();
-    void c_cos(), c_exp(), c_log(), r_cnjg();
-    double cos(), cosh();
-    void c_sin(), c_sqrt();
-    double d_dim(), exp(), r_dim(), d_int(), d_lg10(), d_mod(), d_nint(),
-            d_sign(), sin(), sinh(), sqrt(), tan(), tanh();
-    integer i_dim(), i_dnnt(), i_indx(), i_sign(), i_len();
-    logical l_ge(), l_gt(), l_le(), l_lt();
-    integer i_nint();
-    double r_sign();
-
-    // Local variables //
-    extern // Subroutine // int fooa_(), fooc_(), food_(), fooi_(), foor_(),
-            fool_(), fooz_(), getem_();
-    static char a1[10], a2[10];
-    static complex c1, c2;
-    static doublereal d1, d2;
-    static integer i1, i2;
-    static real r1, r2;
-
-
-    getem_(a1, a2, &c1, &c2, &i1, &i2, &r1, &r2, &d1, &d2, 10L, 10L);
-// / //
-    i__1 = i1 / i2;
-    fooi_(&i__1);
-    r__1 = r1 / i1;
-    foor_(&r__1);
-    d__1 = d1 / i1;
-    food_(&d__1);
-    d__1 = (doublereal) i1;
-    q__1.r = c1.r / d__1, q__1.i = c1.i / d__1;
-    fooc_(&q__1);
-    r__1 = r1 / r2;
-    foor_(&r__1);
-    d__1 = r1 / d1;
-    food_(&d__1);
-    d__1 = d1 / d2;
-    food_(&d__1);
-    d__1 = d1 / r1;
-    food_(&d__1);
-    c_div(&q__1, &c1, &c2);
-    fooc_(&q__1);
-    q__1.r = c1.r / r1, q__1.i = c1.i / r1;
-    fooc_(&q__1);
-    z__1.r = c1.r / d1, z__1.i = c1.i / d1;
-    fooz_(&z__1);
-// ** //
-    i__1 = pow_ii(&i1, &i2);
-    fooi_(&i__1);
-    r__1 = pow_ri(&r1, &i1);
-    foor_(&r__1);
-    d__1 = pow_di(&d1, &i1);
-    food_(&d__1);
-    pow_ci(&q__1, &c1, &i1);
-    fooc_(&q__1);
-    d__1 = (doublereal) r1;
-    d__2 = (doublereal) r2;
-    r__1 = pow_dd(&d__1, &d__2);
-    foor_(&r__1);
-    d__2 = (doublereal) r1;
-    d__1 = pow_dd(&d__2, &d1);
-    food_(&d__1);
-    d__1 = pow_dd(&d1, &d2);
-    food_(&d__1);
-    d__2 = (doublereal) r1;
-    d__1 = pow_dd(&d1, &d__2);
-    food_(&d__1);
-    z__2.r = c1.r, z__2.i = c1.i;
-    z__3.r = c2.r, z__3.i = c2.i;
-    pow_zz(&z__1, &z__2, &z__3);
-    q__1.r = z__1.r, q__1.i = z__1.i;
-    fooc_(&q__1);
-    z__2.r = c1.r, z__2.i = c1.i;
-    z__3.r = r1, z__3.i = 0.;
-    pow_zz(&z__1, &z__2, &z__3);
-    q__1.r = z__1.r, q__1.i = z__1.i;
-    fooc_(&q__1);
-    z__2.r = c1.r, z__2.i = c1.i;
-    z__3.r = d1, z__3.i = 0.;
-    pow_zz(&z__1, &z__2, &z__3);
-    fooz_(&z__1);
-// FFEINTRIN_impABS //
-    r__1 = (doublereal)((  r1  ) >= 0 ? (  r1  ) : -(  r1  ))  ;
-    foor_(&r__1);
-// FFEINTRIN_impACOS //
-    r__1 = acos(r1);
-    foor_(&r__1);
-// FFEINTRIN_impAIMAG //
-    r__1 = r_imag(&c1);
-    foor_(&r__1);
-// FFEINTRIN_impAINT //
-    r__1 = r_int(&r1);
-    foor_(&r__1);
-// FFEINTRIN_impALOG //
-    r__1 = log(r1);
-    foor_(&r__1);
-// FFEINTRIN_impALOG10 //
-    r__1 = r_lg10(&r1);
-    foor_(&r__1);
-// FFEINTRIN_impAMAX0 //
-    r__1 = (real) (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ;
-    foor_(&r__1);
-// FFEINTRIN_impAMAX1 //
-    r__1 = (doublereal)((  r1  ) >= (  r2  ) ? (  r1  ) : (  r2  ))  ;
-    foor_(&r__1);
-// FFEINTRIN_impAMIN0 //
-    r__1 = (real) (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ;
-    foor_(&r__1);
-// FFEINTRIN_impAMIN1 //
-    r__1 = (doublereal)((  r1  ) <= (  r2  ) ? (  r1  ) : (  r2  ))  ;
-    foor_(&r__1);
-// FFEINTRIN_impAMOD //
-    r__1 = r_mod(&r1, &r2);
-    foor_(&r__1);
-// FFEINTRIN_impANINT //
-    r__1 = r_nint(&r1);
-    foor_(&r__1);
-// FFEINTRIN_impASIN //
-    r__1 = asin(r1);
-    foor_(&r__1);
-// FFEINTRIN_impATAN //
-    r__1 = atan(r1);
-    foor_(&r__1);
-// FFEINTRIN_impATAN2 //
-    r__1 = atan2(r1, r2);
-    foor_(&r__1);
-// FFEINTRIN_impCABS //
-    r__1 = c_abs(&c1);
-    foor_(&r__1);
-// FFEINTRIN_impCCOS //
-    c_cos(&q__1, &c1);
-    fooc_(&q__1);
-// FFEINTRIN_impCEXP //
-    c_exp(&q__1, &c1);
-    fooc_(&q__1);
-// FFEINTRIN_impCHAR //
-    *(unsigned char *)&ch__1[0] = i1;
-    fooa_(ch__1, 1L);
-// FFEINTRIN_impCLOG //
-    c_log(&q__1, &c1);
-    fooc_(&q__1);
-// FFEINTRIN_impCONJG //
-    r_cnjg(&q__1, &c1);
-    fooc_(&q__1);
-// FFEINTRIN_impCOS //
-    r__1 = cos(r1);
-    foor_(&r__1);
-// FFEINTRIN_impCOSH //
-    r__1 = cosh(r1);
-    foor_(&r__1);
-// FFEINTRIN_impCSIN //
-    c_sin(&q__1, &c1);
-    fooc_(&q__1);
-// FFEINTRIN_impCSQRT //
-    c_sqrt(&q__1, &c1);
-    fooc_(&q__1);
-// FFEINTRIN_impDABS //
-    d__1 = (( d1 ) >= 0 ? ( d1 ) : -( d1 )) ;
-    food_(&d__1);
-// FFEINTRIN_impDACOS //
-    d__1 = acos(d1);
-    food_(&d__1);
-// FFEINTRIN_impDASIN //
-    d__1 = asin(d1);
-    food_(&d__1);
-// FFEINTRIN_impDATAN //
-    d__1 = atan(d1);
-    food_(&d__1);
-// FFEINTRIN_impDATAN2 //
-    d__1 = atan2(d1, d2);
-    food_(&d__1);
-// FFEINTRIN_impDCOS //
-    d__1 = cos(d1);
-    food_(&d__1);
-// FFEINTRIN_impDCOSH //
-    d__1 = cosh(d1);
-    food_(&d__1);
-// FFEINTRIN_impDDIM //
-    d__1 = d_dim(&d1, &d2);
-    food_(&d__1);
-// FFEINTRIN_impDEXP //
-    d__1 = exp(d1);
-    food_(&d__1);
-// FFEINTRIN_impDIM //
-    r__1 = r_dim(&r1, &r2);
-    foor_(&r__1);
-// FFEINTRIN_impDINT //
-    d__1 = d_int(&d1);
-    food_(&d__1);
-// FFEINTRIN_impDLOG //
-    d__1 = log(d1);
-    food_(&d__1);
-// FFEINTRIN_impDLOG10 //
-    d__1 = d_lg10(&d1);
-    food_(&d__1);
-// FFEINTRIN_impDMAX1 //
-    d__1 = (( d1 ) >= ( d2 ) ? ( d1 ) : ( d2 )) ;
-    food_(&d__1);
-// FFEINTRIN_impDMIN1 //
-    d__1 = (( d1 ) <= ( d2 ) ? ( d1 ) : ( d2 )) ;
-    food_(&d__1);
-// FFEINTRIN_impDMOD //
-    d__1 = d_mod(&d1, &d2);
-    food_(&d__1);
-// FFEINTRIN_impDNINT //
-    d__1 = d_nint(&d1);
-    food_(&d__1);
-// FFEINTRIN_impDPROD //
-    d__1 = (doublereal) r1 * r2;
-    food_(&d__1);
-// FFEINTRIN_impDSIGN //
-    d__1 = d_sign(&d1, &d2);
-    food_(&d__1);
-// FFEINTRIN_impDSIN //
-    d__1 = sin(d1);
-    food_(&d__1);
-// FFEINTRIN_impDSINH //
-    d__1 = sinh(d1);
-    food_(&d__1);
-// FFEINTRIN_impDSQRT //
-    d__1 = sqrt(d1);
-    food_(&d__1);
-// FFEINTRIN_impDTAN //
-    d__1 = tan(d1);
-    food_(&d__1);
-// FFEINTRIN_impDTANH //
-    d__1 = tanh(d1);
-    food_(&d__1);
-// FFEINTRIN_impEXP //
-    r__1 = exp(r1);
-    foor_(&r__1);
-// FFEINTRIN_impIABS //
-    i__1 = (( i1 ) >= 0 ? ( i1 ) : -( i1 )) ;
-    fooi_(&i__1);
-// FFEINTRIN_impICHAR //
-    i__1 = *(unsigned char *)a1;
-    fooi_(&i__1);
-// FFEINTRIN_impIDIM //
-    i__1 = i_dim(&i1, &i2);
-    fooi_(&i__1);
-// FFEINTRIN_impIDNINT //
-    i__1 = i_dnnt(&d1);
-    fooi_(&i__1);
-// FFEINTRIN_impINDEX //
-    i__1 = i_indx(a1, a2, 10L, 10L);
-    fooi_(&i__1);
-// FFEINTRIN_impISIGN //
-    i__1 = i_sign(&i1, &i2);
-    fooi_(&i__1);
-// FFEINTRIN_impLEN //
-    i__1 = i_len(a1, 10L);
-    fooi_(&i__1);
-// FFEINTRIN_impLGE //
-    L__1 = l_ge(a1, a2, 10L, 10L);
-    fool_(&L__1);
-// FFEINTRIN_impLGT //
-    L__1 = l_gt(a1, a2, 10L, 10L);
-    fool_(&L__1);
-// FFEINTRIN_impLLE //
-    L__1 = l_le(a1, a2, 10L, 10L);
-    fool_(&L__1);
-// FFEINTRIN_impLLT //
-    L__1 = l_lt(a1, a2, 10L, 10L);
-    fool_(&L__1);
-// FFEINTRIN_impMAX0 //
-    i__1 = (( i1 ) >= ( i2 ) ? ( i1 ) : ( i2 )) ;
-    fooi_(&i__1);
-// FFEINTRIN_impMAX1 //
-    i__1 = (integer) (doublereal)((  r1  ) >= (  r2  ) ? (  r1  ) : (  r2  ))  ;
-    fooi_(&i__1);
-// FFEINTRIN_impMIN0 //
-    i__1 = (( i1 ) <= ( i2 ) ? ( i1 ) : ( i2 )) ;
-    fooi_(&i__1);
-// FFEINTRIN_impMIN1 //
-    i__1 = (integer) (doublereal)((  r1  ) <= (  r2  ) ? (  r1  ) : (  r2  ))  ;
-    fooi_(&i__1);
-// FFEINTRIN_impMOD //
-    i__1 = i1 % i2;
-    fooi_(&i__1);
-// FFEINTRIN_impNINT //
-    i__1 = i_nint(&r1);
-    fooi_(&i__1);
-// FFEINTRIN_impSIGN //
-    r__1 = r_sign(&r1, &r2);
-    foor_(&r__1);
-// FFEINTRIN_impSIN //
-    r__1 = sin(r1);
-    foor_(&r__1);
-// FFEINTRIN_impSINH //
-    r__1 = sinh(r1);
-    foor_(&r__1);
-// FFEINTRIN_impSQRT //
-    r__1 = sqrt(r1);
-    foor_(&r__1);
-// FFEINTRIN_impTAN //
-    r__1 = tan(r1);
-    foor_(&r__1);
-// FFEINTRIN_impTANH //
-    r__1 = tanh(r1);
-    foor_(&r__1);
-// FFEINTRIN_imp_CMPLX_C //
-    r__1 = c1.r;
-    r__2 = c2.r;
-    q__1.r = r__1, q__1.i = r__2;
-    fooc_(&q__1);
-// FFEINTRIN_imp_CMPLX_D //
-    z__1.r = d1, z__1.i = d2;
-    fooz_(&z__1);
-// FFEINTRIN_imp_CMPLX_I //
-    r__1 = (real) i1;
-    r__2 = (real) i2;
-    q__1.r = r__1, q__1.i = r__2;
-    fooc_(&q__1);
-// FFEINTRIN_imp_CMPLX_R //
-    q__1.r = r1, q__1.i = r2;
-    fooc_(&q__1);
-// FFEINTRIN_imp_DBLE_C //
-    d__1 = (doublereal) c1.r;
-    food_(&d__1);
-// FFEINTRIN_imp_DBLE_D //
-    d__1 = d1;
-    food_(&d__1);
-// FFEINTRIN_imp_DBLE_I //
-    d__1 = (doublereal) i1;
-    food_(&d__1);
-// FFEINTRIN_imp_DBLE_R //
-    d__1 = (doublereal) r1;
-    food_(&d__1);
-// FFEINTRIN_imp_INT_C //
-    i__1 = (integer) c1.r;
-    fooi_(&i__1);
-// FFEINTRIN_imp_INT_D //
-    i__1 = (integer) d1;
-    fooi_(&i__1);
-// FFEINTRIN_imp_INT_I //
-    i__1 = i1;
-    fooi_(&i__1);
-// FFEINTRIN_imp_INT_R //
-    i__1 = (integer) r1;
-    fooi_(&i__1);
-// FFEINTRIN_imp_REAL_C //
-    r__1 = c1.r;
-    foor_(&r__1);
-// FFEINTRIN_imp_REAL_D //
-    r__1 = (real) d1;
-    foor_(&r__1);
-// FFEINTRIN_imp_REAL_I //
-    r__1 = (real) i1;
-    foor_(&r__1);
-// FFEINTRIN_imp_REAL_R //
-    r__1 = r1;
-    foor_(&r__1);
-
-// FFEINTRIN_imp_INT_D: //
-
-// FFEINTRIN_specIDINT //
-    i__1 = (integer) d1;
-    fooi_(&i__1);
-
-// FFEINTRIN_imp_INT_R: //
-
-// FFEINTRIN_specIFIX //
-    i__1 = (integer) r1;
-    fooi_(&i__1);
-// FFEINTRIN_specINT //
-    i__1 = (integer) r1;
-    fooi_(&i__1);
-
-// FFEINTRIN_imp_REAL_D: //
-
-// FFEINTRIN_specSNGL //
-    r__1 = (real) d1;
-    foor_(&r__1);
-
-// FFEINTRIN_imp_REAL_I: //
-
-// FFEINTRIN_specFLOAT //
-    r__1 = (real) i1;
-    foor_(&r__1);
-// FFEINTRIN_specREAL //
-    r__1 = (real) i1;
-    foor_(&r__1);
-
-} // MAIN__ //
-
--------- (end output file from f2c)
-
-*/
-
-#include "gt-f-com.h"
-#include "gtype-f.h"
diff --git a/gcc/f/com.h b/gcc/f/com.h
deleted file mode 100644
index d23db66..0000000
--- a/gcc/f/com.h
+++ /dev/null
@@ -1,290 +0,0 @@
-/* com.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 1997, 2000, 2003, 2004
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      com.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_COM_H
-#define GCC_F_COM_H
-
-/* Simple definitions and enumerations. */
-
-#define FFECOM_dimensionsMAX 7	/* Max # dimensions (quick hack). */
-
-#define FFECOM_SIZE_UNIT "byte"	/* Singular form. */
-#define FFECOM_SIZE_UNITS "bytes"	/* Plural form. */
-
-#define FFECOM_constantNULL NULL_TREE
-#define FFECOM_nonterNULL NULL_TREE
-#define FFECOM_globalNULL NULL_TREE
-#define FFECOM_labelNULL NULL_TREE
-#define FFECOM_storageNULL NULL_TREE
-#define FFECOM_symbolNULL ffecom_symbol_null_
-
-/* Shorthand for types used in f2c.h and that g77 perhaps allows some
-   flexibility regarding in the section below.  I.e. the actual numbers
-   below aren't important, as long as they're unique.  */
-
-#define FFECOM_f2ccodeCHAR 1
-#define FFECOM_f2ccodeSHORT 2
-#define FFECOM_f2ccodeINT 3
-#define FFECOM_f2ccodeLONG 4
-#define FFECOM_f2ccodeLONGLONG 5
-#define FFECOM_f2ccodeCHARPTR 6		/* char * */
-#define FFECOM_f2ccodeFLOAT 7
-#define FFECOM_f2ccodeDOUBLE 8
-#define FFECOM_f2ccodeLONGDOUBLE 9
-#define FFECOM_f2ccodeTWOREALS 10
-#define FFECOM_f2ccodeTWODOUBLEREALS 11
-
-#if FFECOM_DETERMINE_TYPES	/* only for com.c and configure */
-
-/* Begin f2c.h information.  This must match the info in the f2c.h used
-   to build the libf2c with which g77-generated code is linked, or there
-   will probably be bugs, some of them difficult to detect or even trigger.  */
-
-/* The C front-end provides __g77_integer and __g77_uinteger types so that
-   the appropriately-sized signed and unsigned integer types are available
-   for libf2c.  If you change this, also the definitions of those types
-   in ../c-decl.c. */
-#define FFECOM_f2cINTEGER			\
-  (LONG_TYPE_SIZE == FLOAT_TYPE_SIZE		\
-   ? FFECOM_f2ccodeLONG				\
-   : (INT_TYPE_SIZE == FLOAT_TYPE_SIZE		\
-      ? FFECOM_f2ccodeINT			\
-      : (abort (), -1)))
-
-#define FFECOM_f2cLOGICAL FFECOM_f2cINTEGER
-
-/* The C front-end provides __g77_longint and __g77_ulongint types so that
-   the appropriately-sized signed and unsigned integer types are available
-   for libf2c.  If you change this, also the definitions of those types
-   in ../c-decl.c. */
-#define FFECOM_f2cLONGINT				\
- (LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)		\
-  ? FFECOM_f2ccodeLONG					\
-  : (LONG_LONG_TYPE_SIZE == (FLOAT_TYPE_SIZE * 2)	\
-     ? FFECOM_f2ccodeLONGLONG				\
-     : (abort (), -1)))
-
-#define FFECOM_f2cADDRESS FFECOM_f2ccodeCHARPTR
-#define FFECOM_f2cSHORTINT FFECOM_f2ccodeSHORT
-#define FFECOM_f2cREAL FFECOM_f2ccodeFLOAT
-#define FFECOM_f2cDOUBLEREAL FFECOM_f2ccodeDOUBLE
-#define FFECOM_f2cCOMPLEX FFECOM_f2ccodeTWOREALS
-#define FFECOM_f2cDOUBLECOMPLEX FFECOM_f2ccodeTWODOUBLEREALS
-#define FFECOM_f2cSHORTLOGICAL FFECOM_f2ccodeSHORT
-#define FFECOM_f2cLOGICAL1 FFECOM_f2ccodeCHAR
-#define FFECOM_f2cINTEGER1 FFECOM_f2ccodeCHAR
-
-/* These must be f2c's INTEGER type, to match runtime/f2c.h.in.  */
-
-#define FFECOM_f2cFLAG FFECOM_f2cINTEGER
-#define FFECOM_f2cFTNINT FFECOM_f2cINTEGER
-#define FFECOM_f2cFTNLEN FFECOM_f2cINTEGER
-
-#endif	/* #if FFECOM_DETERMINE_TYPES */
-
-/* Everything else in f2c.h, specifically the structures used in
-   interfacing compiled code with the library, must remain exactly
-   as delivered, or g77 internals (mostly com.c and ste.c) must
-   be modified accordingly to compensate.  Or there will be...trouble.  */
-
-typedef enum
-  {
-#define DEFGFRT(CODE,NAME,TYPE,ARGS,VOLATILE,COMPLEX,CONST) CODE,
-#include "com-rt.def"
-#undef DEFGFRT
-    FFECOM_gfrt
-  } ffecomGfrt;
-
-/* Typedefs. */
-
-#ifndef TREE_CODE
-#include "tree.h"
-#endif
-
-typedef tree ffecomConstant;
-typedef tree ffecomNonter;
-typedef tree ffecomLabel;
-typedef tree ffecomGlobal;
-typedef tree ffecomStorage;
-typedef struct _ffecom_symbol_ ffecomSymbol;
-
-struct _ffecom_symbol_
-  {
-    tree decl_tree;
-    tree length_tree;		/* For CHARACTER dummies. */
-    tree vardesc_tree;		/* For NAMELIST. */
-    tree assign_tree;		/* For ASSIGN'ed vars. */
-    bool addr;			/* Is address of item instead of item. */
-  };
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "info.h"
-#include "lab.h"
-#include "storag.h"
-#include "symbol.h"
-
-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. */
-
-extern GTY(()) tree string_type_node;
-extern GTY(()) tree ffecom_integer_type_node;
-extern GTY(()) tree ffecom_integer_zero_node;
-extern GTY(()) tree ffecom_integer_one_node;
-extern GTY(()) tree ffecom_tree_type[FFEINFO_basictype][FFEINFO_kindtype];
-extern ffecomSymbol ffecom_symbol_null_;
-extern ffeinfoKindtype ffecom_pointer_kind_;
-extern ffeinfoKindtype ffecom_label_kind_;
-
-extern int ffecom_f2c_typecode_[FFEINFO_basictype][FFEINFO_kindtype];
-extern GTY(()) tree ffecom_f2c_integer_type_node;
-extern GTY(()) tree ffecom_f2c_address_type_node;
-extern GTY(()) tree ffecom_f2c_real_type_node;
-extern GTY(()) tree ffecom_f2c_doublereal_type_node;
-extern GTY(()) tree ffecom_f2c_complex_type_node;
-extern GTY(()) tree ffecom_f2c_doublecomplex_type_node;
-extern GTY(()) tree ffecom_f2c_longint_type_node;
-extern GTY(()) tree ffecom_f2c_logical_type_node;
-extern GTY(()) tree ffecom_f2c_flag_type_node;
-extern GTY(()) tree ffecom_f2c_ftnlen_type_node;
-extern GTY(()) tree ffecom_f2c_ftnlen_zero_node;
-extern GTY(()) tree ffecom_f2c_ftnlen_one_node;
-extern GTY(()) tree ffecom_f2c_ftnlen_two_node;
-extern GTY(()) tree ffecom_f2c_ptr_to_ftnlen_type_node;
-extern GTY(()) tree ffecom_f2c_ftnint_type_node;
-extern GTY(()) tree ffecom_f2c_ptr_to_ftnint_type_node;
-
-/* Declare functions with prototypes. */
-
-tree ffecom_1 (enum tree_code code, tree type, tree node);
-tree ffecom_1_fn (tree node);
-tree ffecom_2 (enum tree_code code, tree type, tree node1, tree node2);
-bool ffecom_2pass_advise_entrypoint (ffesymbol entry);
-void ffecom_2pass_do_entrypoint (ffesymbol entry);
-tree ffecom_2s (enum tree_code code, tree type, tree node1, tree node2);
-tree ffecom_3 (enum tree_code code, tree type, tree node1, tree node2,
-	       tree node3);
-tree ffecom_3s (enum tree_code code, tree type, tree node1, tree node2,
-		tree node3);
-tree ffecom_arg_expr (ffebld expr, tree *length);
-tree ffecom_arg_ptr_to_const_expr (ffebld expr, tree *length);
-tree ffecom_arg_ptr_to_expr (ffebld expr, tree *length);
-tree ffecom_call_gfrt (ffecomGfrt ix, tree args, tree hook);
-tree ffecom_constantunion_with_type (ffebldConstantUnion *cu, 
-		            tree tree_type,ffebldConst ct);
-tree ffecom_constantunion (ffebldConstantUnion *cu, ffeinfoBasictype bt,
-			   ffeinfoKindtype kt, tree tree_type);
-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);
-void ffecom_decode_include_option (const char *dir);
-tree ffecom_end_compstmt (void);
-void ffecom_end_transition (void);
-void ffecom_exec_transition (void);
-void ffecom_expand_let_stmt (ffebld dest, ffebld source);
-tree ffecom_expr (ffebld expr);
-tree ffecom_expr_assign (ffebld expr);
-tree ffecom_expr_assign_w (ffebld expr);
-tree ffecom_expr_rw (tree type, ffebld expr);
-tree ffecom_expr_w (tree type, ffebld expr);
-void ffecom_finish_compile (void);
-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;
-ffeinfoBasictype ffecom_gfrt_basictype (ffecomGfrt ix);
-ffeinfoKindtype ffecom_gfrt_kindtype (ffecomGfrt ix);
-void ffecom_init_0 (void);
-void ffecom_init_2 (void);
-tree ffecom_list_expr (ffebld list);
-tree ffecom_list_ptr_to_expr (ffebld list);
-tree ffecom_lookup_label (ffelab label);
-tree ffecom_make_tempvar (const char *commentary, tree type,
-			  ffetargetCharacterSize size, int elements);
-tree ffecom_modify (tree newtype, tree lhs, tree rhs);
-void ffecom_save_tree_forever (tree t);
-void ffecom_file (const char *name);
-void ffecom_notify_init_storage (ffestorag st);
-void ffecom_notify_init_symbol (ffesymbol s);
-void ffecom_notify_primary_entry (ffesymbol fn);
-FILE *ffecom_open_include (char *name, ffewhereLine l, ffewhereColumn c);
-void ffecom_prepare_arg_ptr_to_expr (ffebld expr);
-bool ffecom_prepare_end (void);
-void ffecom_prepare_expr_ (ffebld expr, ffebld dest);
-void ffecom_prepare_expr_rw (tree type, ffebld expr);
-void ffecom_prepare_expr_w (tree type, ffebld expr);
-void ffecom_prepare_ptr_to_expr (ffebld expr);
-void ffecom_prepare_return_expr (ffebld expr);
-tree ffecom_ptr_to_const_expr (ffebld expr);
-tree ffecom_ptr_to_expr (ffebld expr);
-tree ffecom_return_expr (ffebld expr);
-tree ffecom_save_tree (tree t);
-void ffecom_start_compstmt (void);
-tree ffecom_start_decl (tree decl, bool is_init);
-void ffecom_sym_commit (ffesymbol s);
-ffesymbol ffecom_sym_end_transition (ffesymbol s);
-ffesymbol ffecom_sym_exec_transition (ffesymbol s);
-ffesymbol ffecom_sym_learned (ffesymbol s);
-void ffecom_sym_retract (ffesymbol s);
-tree ffecom_temp_label (void);
-tree ffecom_truth_value (tree expr);
-tree ffecom_truth_value_invert (tree expr);
-tree ffecom_type_expr (ffebld expr);
-tree ffecom_which_entrypoint_decl (void);
-void ffe_parse_file (int);
-
-/* Define macros. */
-
-#define ffecom_f2c_typecode(bt,kt) ffecom_f2c_typecode_[(bt)][(kt)]
-#define ffecom_label_kind() ffecom_label_kind_
-#define ffecom_pointer_kind() ffecom_pointer_kind_
-#define ffecom_prepare_expr(e) ffecom_prepare_expr_ ((e), NULL)
-
-#define ffecom_init_1()
-#define ffecom_init_3()
-#define ffecom_init_4()
-#define ffecom_terminate_0()
-#define ffecom_terminate_1()
-#define ffecom_terminate_2()
-#define ffecom_terminate_3()
-#define ffecom_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_COM_H */
diff --git a/gcc/f/config-lang.in b/gcc/f/config-lang.in
deleted file mode 100644
index 8ec70f7..0000000
--- a/gcc/f/config-lang.in
+++ /dev/null
@@ -1,38 +0,0 @@
-# Top level configure fragment for GNU FORTRAN.
-#   Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002 Free Software Foundation, Inc.
-
-#This file is part of GNU Fortran.
-
-#GNU Fortran 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.
-
-#GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-#the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-#02111-1307, USA.
-
-# Configure looks for the existence of this file to auto-config each language.
-# We define several parameters used by configure:
-#
-# language	- name of language as it would appear in $(LANGUAGES)
-# compilers	- value to add to $(COMPILERS)
-# stagestuff	- files to add to $(STAGESTUFF)
-
-language="f77"
-
-compilers="f771\$(exeext)"
-
-stagestuff="g77\$(exeext) g77-cross\$(exeext) f771\$(exeext)"
-
-target_libs=target-libf2c
-
-gtfiles="\$(srcdir)/f/com.c \$(srcdir)/f/com.h \$(srcdir)/f/ste.c \$(srcdir)/f/where.h \$(srcdir)/f/where.c \$(srcdir)/f/lex.c"
-
-build_by_default=no
diff --git a/gcc/f/data.c b/gcc/f/data.c
deleted file mode 100644
index 2040f0a..0000000
--- a/gcc/f/data.c
+++ /dev/null
@@ -1,1877 +0,0 @@
-/* data.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-
-   Description:
-      Do the tough things for DATA statement (and INTEGER FOO/.../-style
-      initializations), like implied-DO and suchlike.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "data.h"
-#include "bit.h"
-#include "bld.h"
-#include "com.h"
-#include "expr.h"
-#include "global.h"
-#include "malloc.h"
-#include "st.h"
-#include "storag.h"
-#include "top.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-/* I picked this value as one that, when plugged into a couple of small
-   but nearly identical test cases I have called BIG-0.f and BIG-1.f,
-   causes BIG-1.f to take about 10 times as long (elapsed) to compile
-   (in f771 only) as BIG-0.f.  These test cases differ in that BIG-0.f
-   doesn't put the one initialized variable in a common area that has
-   a large uninitialized array in it, while BIG-1.f does.  The size of
-   the array is this many elements, as long as they all are INTEGER
-   type.  Note that, as of 0.5.18, sparse cases are better handled,
-   so BIG-2.f now is used; it provides nonzero initial
-   values for all elements of the same array BIG-0 has.  */
-#ifndef FFEDATA_sizeTOO_BIG_INIT_
-#define FFEDATA_sizeTOO_BIG_INIT_ 75*1024
-#endif
-
-/* Internal typedefs. */
-
-typedef struct _ffedata_convert_cache_ *ffedataConvertCache_;
-typedef struct _ffedata_impdo_ *ffedataImpdo_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffedata_convert_cache_
-  {
-    ffebld converted;		/* Results of converting expr to following
-				   type. */
-    ffeinfoBasictype basic_type;
-    ffeinfoKindtype kind_type;
-    ffetargetCharacterSize size;
-    ffeinfoRank rank;
-  };
-
-struct _ffedata_impdo_
-  {
-    ffedataImpdo_ outer;	/* Enclosing IMPDO construct. */
-    ffebld outer_list;		/* Item after my IMPDO on the outer list. */
-    ffebld my_list;		/* Beginning of list in my IMPDO. */
-    ffesymbol itervar;		/* Iteration variable. */
-    ffetargetIntegerDefault increment;
-    ffetargetIntegerDefault final;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-static ffedataImpdo_ ffedata_stack_ = NULL;
-static ffebld ffedata_list_ = NULL;
-static bool ffedata_reinit_;	/* value_ should report REINIT error. */
-static bool ffedata_reported_error_;	/* Error has been reported. */
-static ffesymbol ffedata_symbol_ = NULL;	/* Symbol being initialized. */
-static ffeinfoBasictype ffedata_basictype_;	/* Info on symbol. */
-static ffeinfoKindtype ffedata_kindtype_;
-static ffestorag ffedata_storage_;	/* If non-NULL, inits go into this parent. */
-static ffeinfoBasictype ffedata_storage_bt_;	/* Info on storage. */
-static ffeinfoKindtype ffedata_storage_kt_;
-static ffetargetOffset ffedata_storage_size_;	/* Size of entire storage. */
-static ffetargetAlign ffedata_storage_units_;	/* #units per storage unit. */
-static ffetargetOffset ffedata_arraysize_;	/* Size of array being
-						   inited. */
-static ffetargetOffset ffedata_expected_;	/* Number of elements to
-						   init. */
-static ffetargetOffset ffedata_number_;	/* #elements inited so far. */
-static ffetargetOffset ffedata_offset_;	/* Offset of next element. */
-static ffetargetOffset ffedata_symbolsize_;	/* Size of entire sym. */
-static ffetargetCharacterSize ffedata_size_;	/* Size of an element. */
-static ffetargetCharacterSize ffedata_charexpected_;	/* #char to init. */
-static ffetargetCharacterSize ffedata_charnumber_;	/* #chars inited. */
-static ffetargetCharacterSize ffedata_charoffset_;	/* Offset of next char. */
-static ffedataConvertCache_ ffedata_convert_cache_;	/* Fewer conversions. */
-static int ffedata_convert_cache_max_ = 0;	/* #entries available. */
-static int ffedata_convert_cache_use_ = 0;	/* #entries in use. */
-
-/* Static functions (internal). */
-
-static bool ffedata_advance_ (void);
-static ffebld ffedata_convert_ (ffebld source, ffelexToken source_token,
-	    ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
-				ffeinfoRank rk, ffetargetCharacterSize sz);
-static ffetargetInteger1 ffedata_eval_integer1_ (ffebld expr);
-static ffetargetOffset ffedata_eval_offset_ (ffebld subscripts,
-					     ffebld dims);
-static ffetargetCharacterSize ffedata_eval_substr_begin_ (ffebld expr);
-static ffetargetCharacterSize ffedata_eval_substr_end_ (ffebld expr,
-		    ffetargetCharacterSize min, ffetargetCharacterSize max);
-static void ffedata_gather_ (ffestorag mst, ffestorag st);
-static void ffedata_pop_ (void);
-static void ffedata_push_ (void);
-static bool ffedata_value_ (ffebld value, ffelexToken token);
-
-/* Internal macros. */
-
-
-/* ffedata_begin -- Initialize with list of targets
-
-   ffebld list;
-   ffedata_begin(list);	 // ITEM... list of SYMTERs, ARRAYs, SUBSTRs, ...
-
-   Remember the list.  After this call, 0...n calls to ffedata_value must
-   follow, and then a single call to ffedata_end.  */
-
-void
-ffedata_begin (ffebld list)
-{
-  assert (ffedata_list_ == NULL);
-  ffedata_list_ = list;
-  ffedata_symbol_ = NULL;
-  ffedata_reported_error_ = FALSE;
-  ffedata_reinit_ = FALSE;
-  ffedata_advance_ ();
-}
-
-/* ffedata_end -- End of initialization sequence
-
-   if (ffedata_end(FALSE))
-       // everything's ok
-
-   Make sure the end of the list is valid here.	 */
-
-bool
-ffedata_end (bool reported_error, ffelexToken t)
-{
-  reported_error |= ffedata_reported_error_;
-
-  /* If still targets to initialize, too few initializers, so complain. */
-
-  if ((ffedata_symbol_ != NULL) && !reported_error)
-    {
-      reported_error = TRUE;
-      ffebad_start (FFEBAD_DATA_TOOFEW);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_string (ffesymbol_text (ffedata_symbol_));
-      ffebad_finish ();
-    }
-
-  /* Pop off any impdo stacks (present only if ffedata_symbol_ != NULL). */
-
-  while (ffedata_stack_ != NULL)
-    ffedata_pop_ ();
-
-  if (ffedata_list_ != NULL)
-    {
-      assert (reported_error);
-      ffedata_list_ = NULL;
-    }
-
-  return TRUE;
-}
-
-/* ffedata_gather -- Gather previously disparate initializations into one place
-
-   ffestorag st;  // A typeCBLOCK or typeLOCAL aggregate.
-   ffedata_gather(st);
-
-   Prior to this call, st has no init or accretion info, but (presumably
-   at least one of) its subordinate storage areas has init or accretion
-   info.  After this call, none of the subordinate storage areas has inits,
-   because they've all been moved into the newly created init/accretion
-   info for st.	 During this call, conflicting inits produce only one
-   error message.  */
-
-void
-ffedata_gather (ffestorag st)
-{
-  ffesymbol s;
-  ffebld b;
-
-  /* Prepare info on the storage area we're putting init info into. */
-
-  ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
-			    &ffedata_storage_units_, ffestorag_basictype (st),
-			    ffestorag_kindtype (st));
-  ffedata_storage_size_ = ffestorag_size (st) / ffedata_storage_units_;
-  assert (ffestorag_size (st) % ffedata_storage_units_ == 0);
-
-  /* If a CBLOCK, gather all the init info for its explicit members. */
-
-  if ((ffestorag_type (st) == FFESTORAG_typeCBLOCK)
-      && (ffestorag_symbol (st) != NULL))
-    {
-      s = ffestorag_symbol (st);
-      for (b = ffesymbol_commonlist (s); b != NULL; b = ffebld_trail (b))
-	ffedata_gather_ (st,
-			 ffesymbol_storage (ffebld_symter (ffebld_head (b))));
-    }
-
-  /* For CBLOCK or LOCAL, gather all the init info for equivalenced members. */
-
-  ffestorag_drive (ffestorag_list_equivs (st), ffedata_gather_, st);
-}
-
-/* ffedata_value -- Provide some number of initial values
-
-   ffebld value;
-   ffelexToken t;  // Points to the value.
-   if (ffedata_value(1,value,t))
-       // Everything's ok
-
-   Makes sure the value is ok, then remembers it according to the list
-   provided to ffedata_begin.  As many instances of the value may be
-   supplied as desired, as indicated by the first argument.  */
-
-bool
-ffedata_value (ffetargetIntegerDefault rpt, ffebld value, ffelexToken token)
-{
-  ffetargetIntegerDefault i;
-
-  /* Maybe ignore zero values, to speed up compiling, even though we lose
-     checking for multiple initializations for now.  */
-
-  if (!ffe_is_zeros ()
-      && (value != NULL)
-      && (ffebld_op (value) == FFEBLD_opCONTER)
-      && ffebld_constant_is_zero (ffebld_conter (value)))
-    value = NULL;
-  else if ((value != NULL)
-	   && (ffebld_op (value) == FFEBLD_opANY))
-    value = NULL;
-  else
-    {
-      /* Must be a constant. */
-      assert (value != NULL);
-      assert (ffebld_op (value) == FFEBLD_opCONTER);
-    }
-
-  /* Later we can optimize certain cases by seeing that the target array can
-     take some number of values, and provide this number to _value_. */
-
-  if (rpt == 1)
-    ffedata_convert_cache_use_ = -1;	/* Don't bother caching. */
-  else
-    ffedata_convert_cache_use_ = 0;	/* Maybe use the cache. */
-
-  for (i = 0; i < rpt; ++i)
-    {
-      if ((ffedata_symbol_ != NULL)
-	  && !ffesymbol_is_init (ffedata_symbol_))
-	{
-	  ffesymbol_signal_change (ffedata_symbol_);
-	  ffesymbol_update_init (ffedata_symbol_);
-	  if (1 || ffe_is_90 ())
-	    ffesymbol_update_save (ffedata_symbol_);
-#if FFEGLOBAL_ENABLED
-	  if (ffesymbol_common (ffedata_symbol_) != NULL)
-	    ffeglobal_init_common (ffesymbol_common (ffedata_symbol_),
-				   token);
-#endif
-	  ffesymbol_signal_unreported (ffedata_symbol_);
-	}
-      if (!ffedata_value_ (value, token))
-	return FALSE;
-    }
-
-  return TRUE;
-}
-
-/* ffedata_advance_ -- Advance initialization target to next item in list
-
-   if (ffedata_advance_())
-       // everything's ok
-
-   Sets common info to characterize the next item in the list.	Handles
-   IMPDO constructs accordingly.  Does not handle advances within a single
-   item, as in the common extension "DATA CHARTYPE/33,34,35/", where
-   CHARTYPE is CHARACTER*3, for example.  */
-
-static bool
-ffedata_advance_ (void)
-{
-  ffebld next;
-
-  /* Come here after handling an IMPDO. */
-
-tail_recurse:			/* :::::::::::::::::::: */
-
-  /* Assume we're not going to find a new target for now. */
-
-  ffedata_symbol_ = NULL;
-
-  /* If at the end of the list, we're done. */
-
-  if (ffedata_list_ == NULL)
-    {
-      ffetargetIntegerDefault newval;
-
-      if (ffedata_stack_ == NULL)
-	return TRUE;		/* No IMPDO in progress, we is done! */
-
-      /* Iterate the IMPDO. */
-
-      newval = ffesymbol_value (ffedata_stack_->itervar)
-	+ ffedata_stack_->increment;
-
-      /* See if we're still in the loop. */
-
-      if (((ffedata_stack_->increment > 0)
-	   ? newval > ffedata_stack_->final
-	   : newval < ffedata_stack_->final)
-	  || (((ffesymbol_value (ffedata_stack_->itervar) < 0)
-	       == (ffedata_stack_->increment < 0))
-	      && ((ffesymbol_value (ffedata_stack_->itervar) < 0)
-		  != (newval < 0))))	/* Overflow/underflow? */
-	{			/* Done with the loop. */
-	  ffedata_list_ = ffedata_stack_->outer_list;	/* Restore list. */
-	  ffedata_pop_ ();	/* Pop me off the impdo stack. */
-	}
-      else
-	{			/* Still in the loop, reset the list and
-				   update the iter var. */
-	  ffedata_list_ = ffedata_stack_->my_list;	/* Reset list. */
-	  ffesymbol_set_value (ffedata_stack_->itervar, newval);
-	}
-      goto tail_recurse;	/* :::::::::::::::::::: */
-    }
-
-  /* Move to the next item in the list. */
-
-  next = ffebld_head (ffedata_list_);
-  ffedata_list_ = ffebld_trail (ffedata_list_);
-
-  /* Really shouldn't happen. */
-
-  if (next == NULL)
-    return TRUE;
-
-  /* See what kind of target this is. */
-
-  switch (ffebld_op (next))
-    {
-    case FFEBLD_opSYMTER:	/* Simple reference to scalar or array. */
-      ffedata_symbol_ = ffebld_symter (next);
-      ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
-	: ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
-      if (ffedata_storage_ != NULL)
-	{
-	  ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
-				    &ffedata_storage_units_,
-				    ffestorag_basictype (ffedata_storage_),
-				    ffestorag_kindtype (ffedata_storage_));
-	  ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
-	    / ffedata_storage_units_;
-	  assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
-	}
-
-      if ((ffesymbol_init (ffedata_symbol_) != NULL)
-	  || (ffesymbol_accretion (ffedata_symbol_) != NULL)
-	  || ((ffedata_storage_ != NULL)
-	      && (ffestorag_init (ffedata_storage_) != NULL)))
-	{
-#if 0
-	  ffebad_start (FFEBAD_DATA_REINIT);
-	  ffest_ffebad_here_current_stmt (0);
-	  ffebad_string (ffesymbol_text (ffedata_symbol_));
-	  ffebad_finish ();
-	  ffedata_reported_error_ = TRUE;
-	  return FALSE;
-#else
-	  ffedata_reinit_ = TRUE;
-	  return TRUE;
-#endif
-	}
-      ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
-      ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
-      if (ffesymbol_rank (ffedata_symbol_) == 0)
-	ffedata_arraysize_ = 1;
-      else
-	{
-	  ffebld size = ffesymbol_arraysize (ffedata_symbol_);
-
-	  assert (size != NULL);
-	  assert (ffebld_op (size) == FFEBLD_opCONTER);
-	  assert (ffeinfo_basictype (ffebld_info (size))
-		  == FFEINFO_basictypeINTEGER);
-	  assert (ffeinfo_kindtype (ffebld_info (size))
-		  == FFEINFO_kindtypeINTEGERDEFAULT);
-	  ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
-							       (size));
-	}
-      ffedata_expected_ = ffedata_arraysize_;
-      ffedata_number_ = 0;
-      ffedata_offset_ = 0;
-      ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
-	? ffesymbol_size (ffedata_symbol_) : 1;
-      ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
-      ffedata_charexpected_ = ffedata_size_;
-      ffedata_charnumber_ = 0;
-      ffedata_charoffset_ = 0;
-      break;
-
-    case FFEBLD_opARRAYREF:	/* Reference to element of array. */
-      ffedata_symbol_ = ffebld_symter (ffebld_left (next));
-      ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
-	: ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
-      if (ffedata_storage_ != NULL)
-	{
-	  ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
-				    &ffedata_storage_units_,
-				    ffestorag_basictype (ffedata_storage_),
-				    ffestorag_kindtype (ffedata_storage_));
-	  ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
-	    / ffedata_storage_units_;
-	  assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
-	}
-
-      if ((ffesymbol_init (ffedata_symbol_) != NULL)
-	  || ((ffedata_storage_ != NULL)
-	      && (ffestorag_init (ffedata_storage_) != NULL)))
-	{
-#if 0
-	  ffebad_start (FFEBAD_DATA_REINIT);
-	  ffest_ffebad_here_current_stmt (0);
-	  ffebad_string (ffesymbol_text (ffedata_symbol_));
-	  ffebad_finish ();
-	  ffedata_reported_error_ = TRUE;
-	  return FALSE;
-#else
-	  ffedata_reinit_ = TRUE;
-	  return TRUE;
-#endif
-	}
-      ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
-      ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
-      if (ffesymbol_rank (ffedata_symbol_) == 0)
-	ffedata_arraysize_ = 1;	/* Shouldn't happen in this case... */
-      else
-	{
-	  ffebld size = ffesymbol_arraysize (ffedata_symbol_);
-
-	  assert (size != NULL);
-	  assert (ffebld_op (size) == FFEBLD_opCONTER);
-	  assert (ffeinfo_basictype (ffebld_info (size))
-		  == FFEINFO_basictypeINTEGER);
-	  assert (ffeinfo_kindtype (ffebld_info (size))
-		  == FFEINFO_kindtypeINTEGERDEFAULT);
-	  ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
-							       (size));
-	}
-      ffedata_expected_ = 1;
-      ffedata_number_ = 0;
-      ffedata_offset_ = ffedata_eval_offset_ (ffebld_right (next),
-					  ffesymbol_dims (ffedata_symbol_));
-      ffedata_size_ = (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
-	? ffesymbol_size (ffedata_symbol_) : 1;
-      ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
-      ffedata_charexpected_ = ffedata_size_;
-      ffedata_charnumber_ = 0;
-      ffedata_charoffset_ = 0;
-      break;
-
-    case FFEBLD_opSUBSTR:	/* Substring reference to scalar or array
-				   element. */
-      {
-	bool arrayref = ffebld_op (ffebld_left (next)) == FFEBLD_opARRAYREF;
-	ffebld colon = ffebld_right (next);
-
-	assert (colon != NULL);
-
-	ffedata_symbol_ = ffebld_symter (ffebld_left (arrayref
-					      ? ffebld_left (next) : next));
-	ffedata_storage_ = (ffesymbol_storage (ffedata_symbol_) == NULL) ? NULL
-	  : ffestorag_parent (ffesymbol_storage (ffedata_symbol_));
-	if (ffedata_storage_ != NULL)
-	  {
-	    ffetarget_aggregate_info (&ffedata_storage_bt_, &ffedata_storage_kt_,
-				      &ffedata_storage_units_,
-				      ffestorag_basictype (ffedata_storage_),
-				      ffestorag_kindtype (ffedata_storage_));
-	    ffedata_storage_size_ = ffestorag_size (ffedata_storage_)
-	      / ffedata_storage_units_;
-	    assert (ffestorag_size (ffedata_storage_) % ffedata_storage_units_ == 0);
-	  }
-
-	if ((ffesymbol_init (ffedata_symbol_) != NULL)
-	    || ((ffedata_storage_ != NULL)
-		&& (ffestorag_init (ffedata_storage_) != NULL)))
-	  {
-#if 0
-	    ffebad_start (FFEBAD_DATA_REINIT);
-	    ffest_ffebad_here_current_stmt (0);
-	    ffebad_string (ffesymbol_text (ffedata_symbol_));
-	    ffebad_finish ();
-	    ffedata_reported_error_ = TRUE;
-	    return FALSE;
-#else
-	    ffedata_reinit_ = TRUE;
-	    return TRUE;
-#endif
-	  }
-	ffedata_basictype_ = ffesymbol_basictype (ffedata_symbol_);
-	ffedata_kindtype_ = ffesymbol_kindtype (ffedata_symbol_);
-	if (ffesymbol_rank (ffedata_symbol_) == 0)
-	  ffedata_arraysize_ = 1;
-	else
-	  {
-	    ffebld size = ffesymbol_arraysize (ffedata_symbol_);
-
-	    assert (size != NULL);
-	    assert (ffebld_op (size) == FFEBLD_opCONTER);
-	    assert (ffeinfo_basictype (ffebld_info (size))
-		    == FFEINFO_basictypeINTEGER);
-	    assert (ffeinfo_kindtype (ffebld_info (size))
-		    == FFEINFO_kindtypeINTEGERDEFAULT);
-	    ffedata_arraysize_ = ffebld_constant_integerdefault (ffebld_conter
-								 (size));
-	  }
-	ffedata_expected_ = arrayref ? 1 : ffedata_arraysize_;
-	ffedata_number_ = 0;
-	ffedata_offset_ = arrayref ? ffedata_eval_offset_ (ffebld_right
-		(ffebld_left (next)), ffesymbol_dims (ffedata_symbol_)) : 0;
-	ffedata_size_ = ffesymbol_size (ffedata_symbol_);
-	ffedata_symbolsize_ = ffedata_size_ * ffedata_arraysize_;
-	ffedata_charnumber_ = 0;
-	ffedata_charoffset_ = ffedata_eval_substr_begin_ (ffebld_head (colon));
-	ffedata_charexpected_ = ffedata_eval_substr_end_ (ffebld_head
-				(ffebld_trail (colon)), ffedata_charoffset_,
-				   ffedata_size_) - ffedata_charoffset_ + 1;
-      }
-      break;
-
-    case FFEBLD_opIMPDO:	/* Implied-DO construct. */
-      {
-	ffebld itervar;
-	ffebld start;
-	ffebld end;
-	ffebld incr;
-	ffebld item = ffebld_right (next);
-
-	itervar = ffebld_head (item);
-	item = ffebld_trail (item);
-	start = ffebld_head (item);
-	item = ffebld_trail (item);
-	end = ffebld_head (item);
-	item = ffebld_trail (item);
-	incr = ffebld_head (item);
-
-	ffedata_push_ ();
-	ffedata_stack_->outer_list = ffedata_list_;
-	ffedata_stack_->my_list = ffedata_list_ = ffebld_left (next);
-
-	assert (ffeinfo_basictype (ffebld_info (itervar))
-		== FFEINFO_basictypeINTEGER);
-	assert (ffeinfo_kindtype (ffebld_info (itervar))
-		== FFEINFO_kindtypeINTEGERDEFAULT);
-	ffedata_stack_->itervar = ffebld_symter (itervar);
-	if (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER)
-	  {
-	    ffebad_start (FFEBAD_DATA_EVAL);
-	    ffest_ffebad_here_current_stmt (0);
-	    ffebad_finish ();
-	    ffedata_pop_ ();
-	    ffedata_reported_error_ = TRUE;
-	    return FALSE;
-	  }
-	assert (ffeinfo_basictype (ffebld_info (start))
-		== FFEINFO_basictypeINTEGER);
-	assert (ffeinfo_kindtype (ffebld_info (start))
-		== FFEINFO_kindtypeINTEGERDEFAULT);
-	ffesymbol_set_value (ffedata_stack_->itervar, ffedata_eval_integer1_ (start));
-	if (ffeinfo_basictype (ffebld_info (end)) != FFEINFO_basictypeINTEGER)
-	  {
-	    ffebad_start (FFEBAD_DATA_EVAL);
-	    ffest_ffebad_here_current_stmt (0);
-	    ffebad_finish ();
-	    ffedata_pop_ ();
-	    ffedata_reported_error_ = TRUE;
-	    return FALSE;
-	  }
-	assert (ffeinfo_basictype (ffebld_info (end))
-		== FFEINFO_basictypeINTEGER);
-	assert (ffeinfo_kindtype (ffebld_info (end))
-		== FFEINFO_kindtypeINTEGERDEFAULT);
-	ffedata_stack_->final = ffedata_eval_integer1_ (end);
-
-	if (incr == NULL)
-	  ffedata_stack_->increment = 1;
-	else
-	  {
-	    if (ffeinfo_basictype (ffebld_info (incr)) != FFEINFO_basictypeINTEGER)
-	      {
-		ffebad_start (FFEBAD_DATA_EVAL);
-		ffest_ffebad_here_current_stmt (0);
-		ffebad_finish ();
-		ffedata_pop_ ();
-		ffedata_reported_error_ = TRUE;
-		return FALSE;
-	      }
-	    assert (ffeinfo_basictype (ffebld_info (incr))
-		    == FFEINFO_basictypeINTEGER);
-	    assert (ffeinfo_kindtype (ffebld_info (incr))
-		    == FFEINFO_kindtypeINTEGERDEFAULT);
-	    ffedata_stack_->increment = ffedata_eval_integer1_ (incr);
-	    if (ffedata_stack_->increment == 0)
-	      {
-		ffebad_start (FFEBAD_DATA_ZERO);
-		ffest_ffebad_here_current_stmt (0);
-		ffebad_string (ffesymbol_text (ffedata_stack_->itervar));
-		ffebad_finish ();
-		ffedata_pop_ ();
-		ffedata_reported_error_ = TRUE;
-		return FALSE;
-	      }
-	  }
-
-	if ((ffedata_stack_->increment > 0)
-	    ? ffesymbol_value (ffedata_stack_->itervar)
-	    > ffedata_stack_->final
-	    : ffesymbol_value (ffedata_stack_->itervar)
-	    < ffedata_stack_->final)
-	  {
-	    ffedata_reported_error_ = TRUE;
-	    ffebad_start (FFEBAD_DATA_EMPTY);
-	    ffest_ffebad_here_current_stmt (0);
-	    ffebad_string (ffesymbol_text (ffedata_stack_->itervar));
-	    ffebad_finish ();
-	    ffedata_pop_ ();
-	    return FALSE;
-	  }
-      }
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    case FFEBLD_opANY:
-      ffedata_reported_error_ = TRUE;
-      return FALSE;
-
-    default:
-      assert ("bad op" == NULL);
-      break;
-    }
-
-  return TRUE;
-}
-
-/* ffedata_convert_ -- Convert source expression to given type using cache
-
-   ffebld source;
-   ffelexToken source_token;
-   ffelexToken dest_token;  // Any appropriate token for "destination".
-   ffeinfoBasictype bt;
-   ffeinfoKindtype kt;
-   ffetargetCharactersize sz;
-   source = ffedata_convert_(source,source_token,dest_token,bt,kt,sz);
-
-   Like ffeexpr_convert, but calls it only if necessary (if the converted
-   expression doesn't already exist in the cache) and then puts the result
-   in the cache.  */
-
-static ffebld
-ffedata_convert_ (ffebld source, ffelexToken source_token,
-		  ffelexToken dest_token, ffeinfoBasictype bt,
-		  ffeinfoKindtype kt, ffeinfoRank rk,
-		  ffetargetCharacterSize sz)
-{
-  ffebld converted;
-  int i;
-  int max;
-  ffedataConvertCache_ cache;
-
-  for (i = 0; i < ffedata_convert_cache_use_; ++i)
-    if ((bt == ffedata_convert_cache_[i].basic_type)
-	&& (kt == ffedata_convert_cache_[i].kind_type)
-	&& (sz == ffedata_convert_cache_[i].size)
-	&& (rk == ffedata_convert_cache_[i].rank))
-      return ffedata_convert_cache_[i].converted;
-
-  converted = ffeexpr_convert (source, source_token, dest_token, bt, kt, rk,
-			       sz, FFEEXPR_contextDATA);
-
-  if (ffedata_convert_cache_use_ >= ffedata_convert_cache_max_)
-    {
-      if (ffedata_convert_cache_max_ == 0)
-	max = 4;
-      else
-	max = ffedata_convert_cache_max_ << 1;
-
-      if (max > ffedata_convert_cache_max_)
-	{
-	  cache = malloc_new_ks (malloc_pool_image (),
-				 "FFEDATA cache", max * sizeof (*cache));
-	  if (ffedata_convert_cache_max_ != 0)
-	    {
-	      memcpy (cache, ffedata_convert_cache_,
-		      ffedata_convert_cache_max_ * sizeof (*cache));
-	      malloc_kill_ks (malloc_pool_image (), ffedata_convert_cache_,
-			      ffedata_convert_cache_max_ * sizeof (*cache));
-	    }
-	  ffedata_convert_cache_ = cache;
-	  ffedata_convert_cache_max_ = max;
-	}
-      else
-	return converted;	/* In case int overflows! */
-    }
-
-  i = ffedata_convert_cache_use_++;
-
-  ffedata_convert_cache_[i].converted = converted;
-  ffedata_convert_cache_[i].basic_type = bt;
-  ffedata_convert_cache_[i].kind_type = kt;
-  ffedata_convert_cache_[i].size = sz;
-  ffedata_convert_cache_[i].rank = rk;
-
-  return converted;
-}
-
-/* ffedata_eval_integer1_ -- Evaluate expression
-
-   ffetargetIntegerDefault result;
-   ffebld expr;	 // must be kindtypeINTEGER1.
-
-   result = ffedata_eval_integer1_(expr);
-
-   Evalues the expression (which yields a kindtypeINTEGER1 result) and
-   returns the result.	*/
-
-static ffetargetIntegerDefault
-ffedata_eval_integer1_ (ffebld expr)
-{
-  ffetargetInteger1 result;
-  ffebad error;
-
-  assert (expr != NULL);
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opCONTER:
-      return ffebld_constant_integer1 (ffebld_conter (expr));
-
-    case FFEBLD_opSYMTER:
-      return ffesymbol_value (ffebld_symter (expr));
-
-    case FFEBLD_opUPLUS:
-      return ffedata_eval_integer1_ (ffebld_left (expr));
-
-    case FFEBLD_opUMINUS:
-      error = ffetarget_uminus_integer1 (&result,
-			       ffedata_eval_integer1_ (ffebld_left (expr)));
-      break;
-
-    case FFEBLD_opADD:
-      error = ffetarget_add_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opSUBTRACT:
-      error = ffetarget_subtract_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opMULTIPLY:
-      error = ffetarget_multiply_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opDIVIDE:
-      error = ffetarget_divide_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opPOWER:
-      {
-	ffebld r = ffebld_right (expr);
-
-	if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
-	    || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
-	  error = FFEBAD_DATA_EVAL;
-	else
-	  error = ffetarget_power_integerdefault_integerdefault (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-						ffedata_eval_integer1_ (r));
-      }
-      break;
-
-#if 0				/* Only for character basictype. */
-    case FFEBLD_opCONCATENATE:
-      error =;
-      break;
-#endif
-
-    case FFEBLD_opNOT:
-      error = ffetarget_not_integer1 (&result,
-			       ffedata_eval_integer1_ (ffebld_left (expr)));
-      break;
-
-#if 0				/* Only for logical basictype. */
-    case FFEBLD_opLT:
-      error =;
-      break;
-
-    case FFEBLD_opLE:
-      error =;
-      break;
-
-    case FFEBLD_opEQ:
-      error =;
-      break;
-
-    case FFEBLD_opNE:
-      error =;
-      break;
-
-    case FFEBLD_opGT:
-      error =;
-      break;
-
-    case FFEBLD_opGE:
-      error =;
-      break;
-#endif
-
-    case FFEBLD_opAND:
-      error = ffetarget_and_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opOR:
-      error = ffetarget_or_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opXOR:
-      error = ffetarget_xor_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opEQV:
-      error = ffetarget_eqv_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opNEQV:
-      error = ffetarget_neqv_integer1 (&result,
-				ffedata_eval_integer1_ (ffebld_left (expr)),
-			      ffedata_eval_integer1_ (ffebld_right (expr)));
-      break;
-
-    case FFEBLD_opPAREN:
-      return ffedata_eval_integer1_ (ffebld_left (expr));
-
-#if 0				/* ~~ no idea how to do this */
-    case FFEBLD_opPERCENT_LOC:
-      error =;
-      break;
-#endif
-
-#if 0				/* not allowed by ANSI, but perhaps as an
-				   extension someday? */
-    case FFEBLD_opCONVERT:
-      switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	    {
-	    default:
-	      error = FFEBAD_DATA_EVAL;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_basictypeREAL:
-	  switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	    {
-	    default:
-	      error = FFEBAD_DATA_EVAL;
-	      break;
-	    }
-	  break;
-	}
-      break;
-#endif
-
-#if 0				/* not valid ops */
-    case FFEBLD_opREPEAT:
-      error =;
-      break;
-
-    case FFEBLD_opBOUNDS:
-      error =;
-      break;
-#endif
-
-#if 0				/* not allowed by ANSI, but perhaps as an
-				   extension someday? */
-    case FFEBLD_opFUNCREF:
-      error =;
-      break;
-#endif
-
-#if 0				/* not valid ops */
-    case FFEBLD_opSUBRREF:
-      error =;
-      break;
-
-    case FFEBLD_opARRAYREF:
-      error =;
-      break;
-#endif
-
-#if 0				/* not valid for integer1 */
-    case FFEBLD_opSUBSTR:
-      error =;
-      break;
-#endif
-
-    default:
-      error = FFEBAD_DATA_EVAL;
-      break;
-    }
-
-  if (error != FFEBAD)
-    {
-      ffebad_start (error);
-      ffest_ffebad_here_current_stmt (0);
-      ffebad_finish ();
-      result = 0;
-    }
-
-  return result;
-}
-
-/* ffedata_eval_offset_ -- Evaluate offset info array
-
-   ffetargetOffset offset;  // 0...max-1.
-   ffebld subscripts;  // an opITEM list of subscript exprs.
-   ffebld dims;	 // an opITEM list of opBOUNDS exprs.
-
-   result = ffedata_eval_offset_(expr);
-
-   Evalues the expression (which yields a kindtypeINTEGER1 result) and
-   returns the result.	*/
-
-static ffetargetOffset
-ffedata_eval_offset_ (ffebld subscripts, ffebld dims)
-{
-  ffetargetIntegerDefault offset = 0;
-  ffetargetIntegerDefault width = 1;
-  ffetargetIntegerDefault value;
-  ffetargetIntegerDefault lowbound;
-  ffetargetIntegerDefault highbound;
-  ffetargetOffset final;
-  ffebld subscript;
-  ffebld dim;
-  ffebld low;
-  ffebld high;
-  int rank = 0;
-  bool ok;
-
-  while (subscripts != NULL)
-    {
-      ffeinfoKindtype sub_kind, low_kind, hi_kind;
-      ffebld sub1, low1, hi1;
-
-      ++rank;
-      assert (dims != NULL);
-
-      subscript = ffebld_head (subscripts);
-      dim = ffebld_head (dims);
-
-      assert (ffeinfo_basictype (ffebld_info (subscript)) == FFEINFO_basictypeINTEGER);
-      if (ffebld_op (subscript) == FFEBLD_opCONTER)
-	{
-	  /* Force to default - it's a constant expression !  */
-	  sub_kind = ffeinfo_kindtype (ffebld_info (subscript));
-	  sub1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (
-		   sub_kind == FFEINFO_kindtypeINTEGER2 ? subscript->u.conter.expr->u.integer2 :
-		   sub_kind == FFEINFO_kindtypeINTEGER3 ? subscript->u.conter.expr->u.integer3 :
-		   sub_kind == FFEINFO_kindtypeINTEGER4 ? subscript->u.conter.expr->u.integer4 :
-			subscript->u.conter.expr->u.integer1), NULL);
-	  value = ffedata_eval_integer1_ (sub1);
-	}
-      else
-	value = ffedata_eval_integer1_ (subscript);
-
-      assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
-      low = ffebld_left (dim);
-      high = ffebld_right (dim);
-
-      if (low == NULL)
-	lowbound = 1;
-      else
-	{
-	  assert (ffeinfo_basictype (ffebld_info (low)) == FFEINFO_basictypeINTEGER);
-	  if (ffebld_op (low) == FFEBLD_opCONTER)
-	    {
-	      /* Force to default - it's a constant expression !  */
-	      low_kind = ffeinfo_kindtype (ffebld_info (low));
-	      low1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (
-			low_kind == FFEINFO_kindtypeINTEGER2 ? low->u.conter.expr->u.integer2 :
-			low_kind == FFEINFO_kindtypeINTEGER3 ? low->u.conter.expr->u.integer3 :
-			low_kind == FFEINFO_kindtypeINTEGER4 ? low->u.conter.expr->u.integer4 :
-				low->u.conter.expr->u.integer1), NULL);
-	       lowbound = ffedata_eval_integer1_ (low1);
-	     }
-	   else
-	     lowbound = ffedata_eval_integer1_ (low);
-	}
-
-      assert (ffeinfo_basictype (ffebld_info (high)) == FFEINFO_basictypeINTEGER);
-      if (ffebld_op (high) == FFEBLD_opCONTER)
-	{
-	  /* Force to default - it's a constant expression !  */
-	  hi_kind = ffeinfo_kindtype (ffebld_info (high));
-	  hi1 = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val (
-		   hi_kind == FFEINFO_kindtypeINTEGER2 ? high->u.conter.expr->u.integer2 :
-		   hi_kind == FFEINFO_kindtypeINTEGER3 ? high->u.conter.expr->u.integer3 :
-		   hi_kind == FFEINFO_kindtypeINTEGER4 ? high->u.conter.expr->u.integer4 :
-			high->u.conter.expr->u.integer1), NULL);
-	  highbound = ffedata_eval_integer1_ (hi1);
-	}
-      else
-	highbound = ffedata_eval_integer1_ (high);
-
-      if ((value < lowbound) || (value > highbound))
-	{
-	  char rankstr[10];
-
-	  sprintf (rankstr, "%d", rank);
-	  value = lowbound;
-	  ffebad_start (FFEBAD_DATA_SUBSCRIPT);
-	  ffebad_string (ffesymbol_text (ffedata_symbol_));
-	  ffebad_string (rankstr);
-	  ffebad_finish ();
-	}
-
-      subscripts = ffebld_trail (subscripts);
-      dims = ffebld_trail (dims);
-
-      offset += width * (value - lowbound);
-      if (subscripts != NULL)
-	width *= highbound - lowbound + 1;
-    }
-
-  assert (dims == NULL);
-
-  ok = ffetarget_offset (&final, offset);
-  assert (ok);
-
-  return final;
-}
-
-/* ffedata_eval_substr_begin_ -- Evaluate begin-point of substr reference
-
-   ffetargetCharacterSize beginpoint;
-   ffebld endval;  // head(colon).
-
-   beginpoint = ffedata_eval_substr_end_(endval);
-
-   If beginval is NULL, returns 0.  Otherwise makes sure beginval is
-   kindtypeINTEGERDEFAULT, makes sure its value is > 0,
-   and returns its value minus one, or issues an error message.	 */
-
-static ffetargetCharacterSize
-ffedata_eval_substr_begin_ (ffebld expr)
-{
-  ffetargetIntegerDefault val;
-
-  if (expr == NULL)
-    return 0;
-
-  assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER);
-  assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGERDEFAULT);
-
-  val = ffedata_eval_integer1_ (expr);
-
-  if (val < 1)
-    {
-      val = 1;
-      ffebad_start (FFEBAD_DATA_RANGE);
-      ffest_ffebad_here_current_stmt (0);
-      ffebad_string (ffesymbol_text (ffedata_symbol_));
-      ffebad_finish ();
-      ffedata_reported_error_ = TRUE;
-    }
-
-  return val - 1;
-}
-
-/* ffedata_eval_substr_end_ -- Evaluate end-point of substr reference
-
-   ffetargetCharacterSize endpoint;
-   ffebld endval;  // head(trail(colon)).
-   ffetargetCharacterSize min;	// beginpoint of substr reference.
-   ffetargetCharacterSize max;	// size of entity.
-
-   endpoint = ffedata_eval_substr_end_(endval,dflt);
-
-   If endval is NULL, returns max.  Otherwise makes sure endval is
-   kindtypeINTEGERDEFAULT, makes sure its value is > min and <= max,
-   and returns its value minus one, or issues an error message.	 */
-
-static ffetargetCharacterSize
-ffedata_eval_substr_end_ (ffebld expr, ffetargetCharacterSize min,
-			  ffetargetCharacterSize max)
-{
-  ffetargetIntegerDefault val;
-
-  if (expr == NULL)
-    return max - 1;
-
-  assert (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER);
-  assert (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER1);
-
-  val = ffedata_eval_integer1_ (expr);
-
-  if ((val < (ffetargetIntegerDefault) min)
-      || (val > (ffetargetIntegerDefault) max))
-    {
-      val = 1;
-      ffebad_start (FFEBAD_DATA_RANGE);
-      ffest_ffebad_here_current_stmt (0);
-      ffebad_string (ffesymbol_text (ffedata_symbol_));
-      ffebad_finish ();
-      ffedata_reported_error_ = TRUE;
-    }
-
-  return val - 1;
-}
-
-/* ffedata_gather_ -- Gather initial values for sym into master sym inits
-
-   ffestorag mst;  // A typeCBLOCK or typeLOCAL aggregate.
-   ffestorag st;  // A typeCOMMON or typeEQUIV member.
-   ffedata_gather_(mst,st);
-
-   If st has any initialization info, transfer that info into mst and
-   clear st's info.  */
-
-static void
-ffedata_gather_ (ffestorag mst, ffestorag st)
-{
-  ffesymbol s;
-  ffesymbol s_whine;		/* Symbol to complain about in diagnostics. */
-  ffebld b;
-  ffetargetOffset offset;
-  ffetargetOffset units_expected;
-  ffebitCount actual;
-  ffebldConstantArray array;
-  ffebld accter;
-  ffetargetCopyfunc fn;
-  void *ptr1;
-  void *ptr2;
-  size_t size;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffeinfoBasictype ign_bt;
-  ffeinfoKindtype ign_kt;
-  ffetargetAlign units;
-  ffebit bits;
-  ffetargetOffset source_offset;
-  bool whine = FALSE;
-
-  if (st == NULL)
-    return;			/* Nothing to do. */
-
-  s = ffestorag_symbol (st);
-
-  assert (s != NULL);		/* Must have a corresponding symbol (else how
-				   inited?). */
-  assert (ffestorag_init (st) == NULL);	/* No init info on storage itself. */
-  assert (ffestorag_accretion (st) == NULL);
-
-  if ((((b = ffesymbol_init (s)) == NULL)
-       && ((b = ffesymbol_accretion (s)) == NULL))
-      || (ffebld_op (b) == FFEBLD_opANY)
-      || ((ffebld_op (b) == FFEBLD_opCONVERT)
-	  && (ffebld_op (ffebld_left (b)) == FFEBLD_opANY)))
-    return;			/* Nothing to do. */
-
-  /* b now holds the init/accretion expr. */
-
-  ffesymbol_set_init (s, NULL);
-  ffesymbol_set_accretion (s, NULL);
-  ffesymbol_set_accretes (s, 0);
-
-  s_whine = ffestorag_symbol (mst);
-  if (s_whine == NULL)
-    s_whine = s;
-
-  /* Make sure we haven't fully accreted during an array init. */
-
-  if (ffestorag_init (mst) != NULL)
-    {
-      ffebad_start (FFEBAD_DATA_MULTIPLE);
-      ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
-      ffebad_string (ffesymbol_text (s_whine));
-      ffebad_finish ();
-      return;
-    }
-
-  bt = ffeinfo_basictype (ffebld_info (b));
-  kt = ffeinfo_kindtype (ffebld_info (b));
-
-  /* Calculate offset for aggregate area. */
-
-  ffedata_charexpected_ = (bt == FFEINFO_basictypeCHARACTER)
-    ? ffebld_size (b) : 1;
-  ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, bt,
-			    kt);/* Find out unit size of source datum. */
-  assert (units % ffedata_storage_units_ == 0);
-  units_expected = ffedata_charexpected_ * units / ffedata_storage_units_;
-  offset = (ffestorag_offset (st) - ffestorag_offset (mst))
-    / ffedata_storage_units_;
-
-  /* Does an accretion array exist?  If not, create it. */
-
-  if (ffestorag_accretion (mst) == NULL)
-    {
-#if FFEDATA_sizeTOO_BIG_INIT_ != 0
-      if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_)
-	{
-	  char bignum[40];
-
-	  sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_);
-	  ffebad_start (FFEBAD_TOO_BIG_INIT);
-	  ffebad_here (0, ffesymbol_where_line (s_whine),
-		       ffesymbol_where_column (s_whine));
-	  ffebad_string (ffesymbol_text (s_whine));
-	  ffebad_string (bignum);
-	  ffebad_finish ();
-	}
-#endif
-      array = ffebld_constantarray_new (ffedata_storage_bt_,
-				ffedata_storage_kt_, ffedata_storage_size_);
-      accter = ffebld_new_accter (array, ffebit_new (ffe_pool_program_unit (),
-						     ffedata_storage_size_));
-      ffebld_set_info (accter, ffeinfo_new
-		       (ffedata_storage_bt_,
-			ffedata_storage_kt_,
-			1,
-			FFEINFO_kindENTITY,
-			FFEINFO_whereCONSTANT,
-			(ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
-			? 1 : FFETARGET_charactersizeNONE));
-      ffestorag_set_accretion (mst, accter);
-      ffestorag_set_accretes (mst, ffedata_storage_size_);
-    }
-  else
-    {
-      accter = ffestorag_accretion (mst);
-      assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter));
-      array = ffebld_accter (accter);
-    }
-
-  /* Put value in accretion array at desired offset. */
-
-  fn = ffetarget_aggregate_ptr_memcpy (ffedata_storage_bt_, ffedata_storage_kt_,
-				       bt, kt);
-
-  switch (ffebld_op (b))
-    {
-    case FFEBLD_opCONTER:
-      ffebld_constantarray_prepare (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
-				    ffedata_storage_kt_, offset,
-			   ffebld_constant_ptr_to_union (ffebld_conter (b)),
-				    bt, kt);
-      (*fn) (ptr1, ptr2, size);	/* Does the appropriate memcpy-like
-				   operation. */
-      ffebit_count (ffebld_accter_bits (accter),
-		    offset, FALSE, units_expected, &actual);	/* How many FALSE? */
-      if (units_expected != (ffetargetOffset) actual)
-	{
-	  ffebad_start (FFEBAD_DATA_MULTIPLE);
-	  ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_finish ();
-	}
-      ffestorag_set_accretes (mst,
-			      ffestorag_accretes (mst)
-			      - actual);	/* Decrement # of values
-						   actually accreted. */
-      ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected);
-
-      /* If done accreting for this storage area, establish as initialized. */
-
-      if (ffestorag_accretes (mst) == 0)
-	{
-	  ffestorag_set_init (mst, accter);
-	  ffestorag_set_accretion (mst, NULL);
-	  ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
-	  ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
-	  ffebld_set_arrter (ffestorag_init (mst),
-			     ffebld_accter (ffestorag_init (mst)));
-	  ffebld_arrter_set_size (ffestorag_init (mst),
-				  ffedata_storage_size_);
-	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
-	  ffecom_notify_init_storage (mst);
-	}
-
-      return;
-
-    case FFEBLD_opARRTER:
-      ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
-			     ffedata_storage_kt_, offset, ffebld_arrter (b),
-				      bt, kt);
-      size *= ffebld_arrter_size (b);
-      units_expected *= ffebld_arrter_size (b);
-      (*fn) (ptr1, ptr2, size);	/* Does the appropriate memcpy-like
-				   operation. */
-      ffebit_count (ffebld_accter_bits (accter),
-		    offset, FALSE, units_expected, &actual);	/* How many FALSE? */
-      if (units_expected != (ffetargetOffset) actual)
-	{
-	  ffebad_start (FFEBAD_DATA_MULTIPLE);
-	  ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_finish ();
-	}
-      ffestorag_set_accretes (mst,
-			      ffestorag_accretes (mst)
-			      - actual);	/* Decrement # of values
-						   actually accreted. */
-      ffebit_set (ffebld_accter_bits (accter), offset, 1, units_expected);
-
-      /* If done accreting for this storage area, establish as initialized. */
-
-      if (ffestorag_accretes (mst) == 0)
-	{
-	  ffestorag_set_init (mst, accter);
-	  ffestorag_set_accretion (mst, NULL);
-	  ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
-	  ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
-	  ffebld_set_arrter (ffestorag_init (mst),
-			     ffebld_accter (ffestorag_init (mst)));
-	  ffebld_arrter_set_size (ffestorag_init (mst),
-				  ffedata_storage_size_);
-	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
-	  ffecom_notify_init_storage (mst);
-	}
-
-      return;
-
-    case FFEBLD_opACCTER:
-      ffebld_constantarray_preparray (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
-			     ffedata_storage_kt_, offset, ffebld_accter (b),
-				      bt, kt);
-      bits = ffebld_accter_bits (b);
-      source_offset = 0;
-
-      for (;;)
-	{
-	  ffetargetOffset unexp;
-	  ffetargetOffset siz;
-	  ffebitCount length;
-	  bool value;
-
-	  ffebit_test (bits, source_offset, &value, &length);
-	  if (length == 0)
-	    break;		/* Exit the loop early. */
-	  siz = size * length;
-	  unexp = units_expected * length;
-	  if (value)
-	    {
-	      (*fn) (ptr1, ptr2, siz);	/* Does memcpy-like operation. */
-	      ffebit_count (ffebld_accter_bits (accter),	/* How many FALSE? */
-			    offset, FALSE, unexp, &actual);
-	      if (!whine && (unexp != (ffetargetOffset) actual))
-		{
-		  whine = TRUE;	/* Don't whine more than once for one gather. */
-		  ffebad_start (FFEBAD_DATA_MULTIPLE);
-		  ffebad_here (0, ffewhere_line_unknown (), ffewhere_column_unknown ());
-		  ffebad_string (ffesymbol_text (s));
-		  ffebad_finish ();
-		}
-	      ffestorag_set_accretes (mst,
-				      ffestorag_accretes (mst)
-				      - actual);	/* Decrement # of values
-							   actually accreted. */
-	      ffebit_set (ffebld_accter_bits (accter), offset, 1, unexp);
-	    }
-	  source_offset += length;
-	  offset += unexp;
-	  ptr1 = ((char *) ptr1) + siz;
-	  ptr2 = ((char *) ptr2) + siz;
-	}
-
-      /* If done accreting for this storage area, establish as initialized. */
-
-      if (ffestorag_accretes (mst) == 0)
-	{
-	  ffestorag_set_init (mst, accter);
-	  ffestorag_set_accretion (mst, NULL);
-	  ffebit_kill (ffebld_accter_bits (ffestorag_init (mst)));
-	  ffebld_set_op (ffestorag_init (mst), FFEBLD_opARRTER);
-	  ffebld_set_arrter (ffestorag_init (mst),
-			     ffebld_accter (ffestorag_init (mst)));
-	  ffebld_arrter_set_size (ffestorag_init (mst),
-				  ffedata_storage_size_);
-	  ffebld_arrter_set_pad (ffestorag_init (mst), 0);
-	  ffecom_notify_init_storage (mst);
-	}
-
-      return;
-
-    default:
-      assert ("bad init op in gather_" == NULL);
-      return;
-    }
-}
-
-/* ffedata_pop_ -- Pop an impdo stack entry
-
-   ffedata_pop_();  */
-
-static void
-ffedata_pop_ (void)
-{
-  ffedataImpdo_ victim = ffedata_stack_;
-
-  assert (victim != NULL);
-
-  ffedata_stack_ = ffedata_stack_->outer;
-
-  malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
-}
-
-/* ffedata_push_ -- Push an impdo stack entry
-
-   ffedata_push_();  */
-
-static void
-ffedata_push_ (void)
-{
-  ffedataImpdo_ baby;
-
-  baby = malloc_new_ks (ffe_pool_program_unit (), "ffedataImpdo_", sizeof (*baby));
-
-  baby->outer = ffedata_stack_;
-  ffedata_stack_ = baby;
-}
-
-/* ffedata_value_ -- Provide an initial value
-
-   ffebld value;
-   ffelexToken t;  // Points to the value.
-   if (ffedata_value(value,t))
-       // Everything's ok
-
-   Makes sure the value is ok, then remembers it according to the list
-   provided to ffedata_begin.  */
-
-static bool
-ffedata_value_ (ffebld value, ffelexToken token)
-{
-
-  /* If already reported an error, don't do anything. */
-
-  if (ffedata_reported_error_)
-    return FALSE;
-
-  /* If the value is an error marker, remember we've seen one and do nothing
-     else. */
-
-  if ((value != NULL)
-      && (ffebld_op (value) == FFEBLD_opANY))
-    {
-      ffedata_reported_error_ = TRUE;
-      return FALSE;
-    }
-
-  /* If too many values (no more targets), complain. */
-
-  if (ffedata_symbol_ == NULL)
-    {
-      ffebad_start (FFEBAD_DATA_TOOMANY);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-      ffedata_reported_error_ = TRUE;
-      return FALSE;
-    }
-
-  /* If ffedata_advance_ wanted to register a complaint, do it now
-     that we have the token to point at instead of just the start
-     of the whole statement.  */
-
-  if (ffedata_reinit_)
-    {
-      ffebad_start (FFEBAD_DATA_REINIT);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_string (ffesymbol_text (ffedata_symbol_));
-      ffebad_finish ();
-      ffedata_reported_error_ = TRUE;
-      return FALSE;
-    }
-
-#if FFEGLOBAL_ENABLED
-  if (ffesymbol_common (ffedata_symbol_) != NULL)
-    ffeglobal_init_common (ffesymbol_common (ffedata_symbol_), token);
-#endif
-
-  /* Convert value to desired type. */
-
-  if (value != NULL)
-    {
-      if (ffedata_convert_cache_use_ == -1)
-	value = ffeexpr_convert
-	  (value, token, NULL, ffedata_basictype_,
-	   ffedata_kindtype_, 0,
-	   (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
-	   ? ffedata_charexpected_ : FFETARGET_charactersizeNONE,
-	   FFEEXPR_contextDATA);
-      else				/* Use the cache. */
-	value = ffedata_convert_
-	  (value, token, NULL, ffedata_basictype_,
-	   ffedata_kindtype_, 0,
-	   (ffedata_basictype_ == FFEINFO_basictypeCHARACTER)
-	   ? ffedata_charexpected_ : FFETARGET_charactersizeNONE);
-    }
-
-  /* If we couldn't, bug out. */
-
-  if ((value != NULL) && (ffebld_op (value) == FFEBLD_opANY))
-    {
-      ffedata_reported_error_ = TRUE;
-      return FALSE;
-    }
-
-  /* Handle the case where initializes go to a parent's storage area. */
-
-  if (ffedata_storage_ != NULL)
-    {
-      ffetargetOffset offset;
-      ffetargetOffset units_expected;
-      ffebitCount actual;
-      ffebldConstantArray array;
-      ffebld accter;
-      ffetargetCopyfunc fn;
-      void *ptr1;
-      void *ptr2;
-      size_t size;
-      ffeinfoBasictype ign_bt;
-      ffeinfoKindtype ign_kt;
-      ffetargetAlign units;
-
-      /* Make sure we haven't fully accreted during an array init. */
-
-      if (ffestorag_init (ffedata_storage_) != NULL)
-	{
-	  ffebad_start (FFEBAD_DATA_MULTIPLE);
-	  ffebad_here (0, ffelex_token_where_line (token),
-		       ffelex_token_where_column (token));
-	  ffebad_string (ffesymbol_text (ffedata_symbol_));
-	  ffebad_finish ();
-	  ffedata_reported_error_ = TRUE;
-	  return FALSE;
-	}
-
-      /* Calculate offset. */
-
-      offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_;
-
-      /* Is offset within range?  If not, whine, but don't do anything else. */
-
-      if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_)
-	{
-	  ffebad_start (FFEBAD_DATA_RANGE);
-	  ffest_ffebad_here_current_stmt (0);
-	  ffebad_string (ffesymbol_text (ffedata_symbol_));
-	  ffebad_finish ();
-	  ffedata_reported_error_ = TRUE;
-	  return FALSE;
-	}
-
-      /* Now calculate offset for aggregate area. */
-
-      ffetarget_aggregate_info (&ign_bt, &ign_kt, &units, ffedata_basictype_,
-				ffedata_kindtype_);	/* Find out unit size of
-							   source datum. */
-      assert (units % ffedata_storage_units_ == 0);
-      units_expected = ffedata_charexpected_ * units / ffedata_storage_units_;
-      offset *= units / ffedata_storage_units_;
-      offset += (ffestorag_offset (ffesymbol_storage (ffedata_symbol_))
-		 - ffestorag_offset (ffedata_storage_))
-	/ ffedata_storage_units_;
-
-      assert (offset + units_expected - 1 <= ffedata_storage_size_);
-
-      /* Does an accretion array exist?	 If not, create it. */
-
-      if (value != NULL)
-	{
-	  if (ffestorag_accretion (ffedata_storage_) == NULL)
-	    {
-#if FFEDATA_sizeTOO_BIG_INIT_ != 0
-	      if (ffedata_storage_size_ >= FFEDATA_sizeTOO_BIG_INIT_)
-		{
-		  char bignum[40];
-
-		  sprintf (&bignum[0], "%ld", (long) ffedata_storage_size_);
-		  ffebad_start (FFEBAD_TOO_BIG_INIT);
-		  ffebad_here (0, ffelex_token_where_line (token),
-			       ffelex_token_where_column (token));
-		  ffebad_string (ffesymbol_text (ffedata_symbol_));
-		  ffebad_string (bignum);
-		  ffebad_finish ();
-		}
-#endif
-	      array = ffebld_constantarray_new
-		(ffedata_storage_bt_, ffedata_storage_kt_,
-		 ffedata_storage_size_);
-	      accter = ffebld_new_accter (array,
-					  ffebit_new (ffe_pool_program_unit (),
-						      ffedata_storage_size_));
-	      ffebld_set_info (accter, ffeinfo_new
-			       (ffedata_storage_bt_,
-				ffedata_storage_kt_,
-				1,
-				FFEINFO_kindENTITY,
-				FFEINFO_whereCONSTANT,
-				(ffedata_basictype_
-				 == FFEINFO_basictypeCHARACTER)
-				? 1 : FFETARGET_charactersizeNONE));
-	      ffestorag_set_accretion (ffedata_storage_, accter);
-	      ffestorag_set_accretes (ffedata_storage_, ffedata_storage_size_);
-	    }
-	  else
-	    {
-	      accter = ffestorag_accretion (ffedata_storage_);
-	      assert (ffedata_storage_size_ == (ffetargetOffset) ffebld_accter_size (accter));
-	      array = ffebld_accter (accter);
-	    }
-
-	  /* Put value in accretion array at desired offset. */
-
-	  fn = ffetarget_aggregate_ptr_memcpy
-	    (ffedata_storage_bt_, ffedata_storage_kt_,
-	     ffedata_basictype_, ffedata_kindtype_);
-	  ffebld_constantarray_prepare
-	    (&ptr1, &ptr2, &size, array, ffedata_storage_bt_,
-	     ffedata_storage_kt_, offset,
-	     ffebld_constant_ptr_to_union (ffebld_conter (value)),
-	     ffedata_basictype_, ffedata_kindtype_);
-	  (*fn) (ptr1, ptr2, size);	/* Does the appropriate memcpy-like
-					   operation. */
-	  ffebit_count (ffebld_accter_bits (accter),
-			offset, FALSE, units_expected,
-			&actual);	/* How many FALSE? */
-	  if (units_expected != (ffetargetOffset) actual)
-	    {
-	      ffebad_start (FFEBAD_DATA_MULTIPLE);
-	      ffebad_here (0, ffelex_token_where_line (token),
-			   ffelex_token_where_column (token));
-	      ffebad_string (ffesymbol_text (ffedata_symbol_));
-	      ffebad_finish ();
-	    }
-	  ffestorag_set_accretes (ffedata_storage_,
-				  ffestorag_accretes (ffedata_storage_)
-				  - actual);	/* Decrement # of values
-						   actually accreted. */
-	  ffebit_set (ffebld_accter_bits (accter), offset,
-		      1, units_expected);
-
-	  /* If done accreting for this storage area, establish as
-	     initialized. */
-
-	  if (ffestorag_accretes (ffedata_storage_) == 0)
-	    {
-	      ffestorag_set_init (ffedata_storage_, accter);
-	      ffestorag_set_accretion (ffedata_storage_, NULL);
-	      ffebit_kill (ffebld_accter_bits
-			   (ffestorag_init (ffedata_storage_)));
-	      ffebld_set_op (ffestorag_init (ffedata_storage_),
-			     FFEBLD_opARRTER);
-	      ffebld_set_arrter
-		(ffestorag_init (ffedata_storage_),
-		 ffebld_accter (ffestorag_init (ffedata_storage_)));
-	      ffebld_arrter_set_size (ffestorag_init (ffedata_storage_),
-				      ffedata_storage_size_);
-	      ffebld_arrter_set_pad (ffestorag_init (ffedata_storage_),
-				     0);
-	      ffecom_notify_init_storage (ffedata_storage_);
-	    }
-	}
-
-      /* If still accreting, adjust specs accordingly and return. */
-
-      if (++ffedata_number_ < ffedata_expected_)
-	{
-	  ++ffedata_offset_;
-	  return TRUE;
-	}
-
-      return ffedata_advance_ ();
-    }
-
-  /* Figure out where the value goes -- in an accretion array or directly
-     into the final initial-value slot for the symbol. */
-
-  if ((ffedata_number_ != 0)
-      || (ffedata_arraysize_ > 1)
-      || (ffedata_charnumber_ != 0)
-      || (ffedata_size_ > ffedata_charexpected_))
-    {				/* Accrete this value. */
-      ffetargetOffset offset;
-      ffebitCount actual;
-      ffebldConstantArray array;
-      ffebld accter = NULL;
-
-      /* Calculate offset. */
-
-      offset = ffedata_offset_ * ffedata_size_ + ffedata_charoffset_;
-
-      /* Is offset within range?  If not, whine, but don't do anything else. */
-
-      if (offset + ffedata_charexpected_ - 1 > ffedata_symbolsize_)
-	{
-	  ffebad_start (FFEBAD_DATA_RANGE);
-	  ffest_ffebad_here_current_stmt (0);
-	  ffebad_string (ffesymbol_text (ffedata_symbol_));
-	  ffebad_finish ();
-	  ffedata_reported_error_ = TRUE;
-	  return FALSE;
-	}
-
-      /* Does an accretion array exist?	 If not, create it. */
-
-      if (value != NULL)
-	{
-	  if (ffesymbol_accretion (ffedata_symbol_) == NULL)
-	    {
-#if FFEDATA_sizeTOO_BIG_INIT_ != 0
-	      if (ffedata_symbolsize_ >= FFEDATA_sizeTOO_BIG_INIT_ )
-		{
-		  char bignum[40];
-
-		  sprintf (&bignum[0], "%ld", (long) ffedata_symbolsize_);
-		  ffebad_start (FFEBAD_TOO_BIG_INIT);
-		  ffebad_here (0, ffelex_token_where_line (token),
-			       ffelex_token_where_column (token));
-		  ffebad_string (ffesymbol_text (ffedata_symbol_));
-		  ffebad_string (bignum);
-		  ffebad_finish ();
-		}
-#endif
-	      array = ffebld_constantarray_new
-		(ffedata_basictype_, ffedata_kindtype_,
-		 ffedata_symbolsize_);
-	      accter = ffebld_new_accter (array,
-					  ffebit_new (ffe_pool_program_unit (),
-						      ffedata_symbolsize_));
-	      ffebld_set_info (accter, ffeinfo_new
-			       (ffedata_basictype_,
-				ffedata_kindtype_,
-				1,
-				FFEINFO_kindENTITY,
-				FFEINFO_whereCONSTANT,
-				(ffedata_basictype_
-				 == FFEINFO_basictypeCHARACTER)
-				? 1 : FFETARGET_charactersizeNONE));
-	      ffesymbol_set_accretion (ffedata_symbol_, accter);
-	      ffesymbol_set_accretes (ffedata_symbol_, ffedata_symbolsize_);
-	    }
-	  else
-	    {
-	      accter = ffesymbol_accretion (ffedata_symbol_);
-	      assert (ffedata_symbolsize_
-		      == (ffetargetOffset) ffebld_accter_size (accter));
-	      array = ffebld_accter (accter);
-	    }
-
-	  /* Put value in accretion array at desired offset. */
-
-	  ffebld_constantarray_put
-	    (array, ffedata_basictype_, ffedata_kindtype_,
-	     offset, ffebld_constant_union (ffebld_conter (value)));
-	  ffebit_count (ffebld_accter_bits (accter), offset, FALSE,
-			ffedata_charexpected_,
-			&actual);	/* How many FALSE? */
-	  if (actual != (unsigned long int) ffedata_charexpected_)
-	    {
-	      ffebad_start (FFEBAD_DATA_MULTIPLE);
-	      ffebad_here (0, ffelex_token_where_line (token),
-			   ffelex_token_where_column (token));
-	      ffebad_string (ffesymbol_text (ffedata_symbol_));
-	      ffebad_finish ();
-	    }
-	  ffesymbol_set_accretes (ffedata_symbol_,
-				  ffesymbol_accretes (ffedata_symbol_)
-				  - actual);	/* Decrement # of values
-						   actually accreted. */
-	  ffebit_set (ffebld_accter_bits (accter), offset,
-		      1, ffedata_charexpected_);
-	  ffesymbol_signal_unreported (ffedata_symbol_);
-	}
-
-      /* If still accreting, adjust specs accordingly and return. */
-
-      if (++ffedata_number_ < ffedata_expected_)
-	{
-	  ++ffedata_offset_;
-	  return TRUE;
-	}
-
-      /* Else, if done accreting for this symbol, establish as initialized. */
-
-      if ((value != NULL)
-	  && (ffesymbol_accretes (ffedata_symbol_) == 0))
-	{
-	  ffesymbol_set_init (ffedata_symbol_, accter);
-	  ffesymbol_set_accretion (ffedata_symbol_, NULL);
-	  ffebit_kill (ffebld_accter_bits (ffesymbol_init (ffedata_symbol_)));
-	  ffebld_set_op (ffesymbol_init (ffedata_symbol_), FFEBLD_opARRTER);
-	  ffebld_set_arrter (ffesymbol_init (ffedata_symbol_),
-			  ffebld_accter (ffesymbol_init (ffedata_symbol_)));
-	  ffebld_arrter_set_size (ffesymbol_init (ffedata_symbol_),
-				  ffedata_symbolsize_);
-	  ffebld_arrter_set_pad (ffestorag_init (ffedata_symbol_), 0);
-	  ffecom_notify_init_symbol (ffedata_symbol_);
-	}
-    }
-  else if (value != NULL)
-    {
-      /* Simple, direct, one-shot assignment. */
-      ffesymbol_set_init (ffedata_symbol_, value);
-      ffecom_notify_init_symbol (ffedata_symbol_);
-    }
-
-  /* Call on advance function to get next target in list. */
-
-  return ffedata_advance_ ();
-}
diff --git a/gcc/f/data.h b/gcc/f/data.h
deleted file mode 100644
index a99369d..0000000
--- a/gcc/f/data.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/* data.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      data.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_DATA_H
-#define GCC_F_DATA_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "lex.h"
-#include "storag.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffedata_begin (ffebld list);
-bool ffedata_end (bool report_errors, ffelexToken t);
-void ffedata_gather (ffestorag st);
-bool ffedata_value (ffetargetIntegerDefault rpt, ffebld value,
-		    ffelexToken value_token);
-
-/* Define macros. */
-
-#define ffedata_init_0()
-#define ffedata_init_1()
-#define ffedata_init_2()
-#define ffedata_init_3()
-#define ffedata_init_4()
-#define ffedata_terminate_0()
-#define ffedata_terminate_1()
-#define ffedata_terminate_2()
-#define ffedata_terminate_3()
-#define ffedata_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_DATA_H */
diff --git a/gcc/f/equiv.c b/gcc/f/equiv.c
deleted file mode 100644
index bd7ac6d..0000000
--- a/gcc/f/equiv.c
+++ /dev/null
@@ -1,1484 +0,0 @@
-/* equiv.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 1998, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Handles the EQUIVALENCE relationships in a program unit.
-
-   Modifications:
-*/
-
-#define FFEEQUIV_DEBUG 0
-
-/* Include files. */
-
-#include "proj.h"
-#include "equiv.h"
-#include "bad.h"
-#include "bld.h"
-#include "com.h"
-#include "data.h"
-#include "global.h"
-#include "lex.h"
-#include "malloc.h"
-#include "symbol.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffeequiv_list_
-  {
-    ffeequiv first;
-    ffeequiv last;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-static struct _ffeequiv_list_ ffeequiv_list_;
-
-/* Static functions (internal). */
-
-static void ffeequiv_destroy_ (ffeequiv eq);
-static void ffeequiv_layout_local_ (ffeequiv eq);
-static bool ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s,
-			      ffebld expr, bool subtract,
-			      ffetargetOffset adjust, bool no_precede);
-
-/* Internal macros. */
-
-
-static void
-ffeequiv_destroy_ (ffeequiv victim)
-{
-  ffebld list;
-  ffebld item;
-  ffebld expr;
-
-  for (list = victim->list; list != NULL; list = ffebld_trail (list))
-    {
-      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
-	{
-	  ffesymbol sym;
-
-	  expr = ffebld_head (item);
-	  sym = ffeequiv_symbol (expr);
-	  if (sym == NULL)
-	    continue;
-	  if (ffesymbol_equiv (sym) != NULL)
-	    ffesymbol_set_equiv (sym, NULL);
-	}
-    }
-  ffeequiv_kill (victim);
-}
-
-/* ffeequiv_layout_local_ -- Lay out storage for local equivalenced vars
-
-   ffeequiv eq;
-   ffeequiv_layout_local_(eq);
-
-   Makes a single master ffestorag object that contains all the vars
-   in the equivalence, and makes subordinate ffestorag objects for the
-   vars with the correct offsets.
-
-   The resulting var offsets are relative not necessarily to 0 -- the
-   are relative to the offset of the master area, which might be 0 or
-   negative, but should never be positive.  */
-
-static void
-ffeequiv_layout_local_ (ffeequiv eq)
-{
-  ffestorag st;			/* Equivalence storage area. */
-  ffebld list;			/* List of list of equivalences. */
-  ffebld item;			/* List of equivalences. */
-  ffebld root_exp;		/* Expression for root sym. */
-  ffestorag root_st;		/* Storage for root. */
-  ffesymbol root_sym;		/* Root itself. */
-  ffebld rooted_exp;		/* Expression for rooted sym in an eqlist. */
-  ffestorag rooted_st;		/* Storage for rooted. */
-  ffesymbol rooted_sym;		/* Rooted symbol itself. */
-  ffetargetOffset eqlist_offset;/* Offset for eqlist from rooted sym. */
-  ffetargetAlign alignment;
-  ffetargetAlign modulo;
-  ffetargetAlign pad;
-  ffetargetOffset size;
-  ffetargetOffset num_elements;
-  bool new_storage;		/* Established new storage info. */
-  bool need_storage;		/* Have need for more storage info. */
-  bool init;
-
-  assert (eq != NULL);
-
-  if (ffeequiv_common (eq) != NULL)
-    {				/* Put in common due to programmer error. */
-      ffeequiv_destroy_ (eq);
-      return;
-    }
-
-  /* Find the symbol for the first valid item in the list of lists, use that
-     as the root symbol.  Doesn't matter if it won't end up at the beginning
-     of the list, though.  */
-
-#if FFEEQUIV_DEBUG
-  fprintf (stderr, "Equiv1:\n");
-#endif
-
-  root_sym = NULL;
-  root_exp = NULL;
-
-  for (list = ffeequiv_list (eq);
-       list != NULL;
-       list = ffebld_trail (list))
-    {				/* For every equivalence list in the list of
-				   equivs */
-      for (item = ffebld_head (list);
-	   item != NULL;
-	   item = ffebld_trail (item))
-	{			/* For every equivalence item in the list */
-	  ffetargetOffset ign;	/* Ignored. */
-
-	  root_exp = ffebld_head (item);
-	  root_sym = ffeequiv_symbol (root_exp);
-	  if (root_sym == NULL)
-	    continue;		/* Ignore me. */
-
-	  assert (ffesymbol_storage (root_sym) == NULL);	/* No storage yet. */
-
-	  if (!ffeequiv_offset_ (&ign, root_sym, root_exp, FALSE, 0, FALSE))
-	    {
-	      /* We can't just eliminate this one symbol from the list
-		 of candidates, because it might be the only one that
-		 ties all these equivs together.  So just destroy the
-		 whole list.  */
-
-	      ffeequiv_destroy_ (eq);
-	      return;
-	    }
-
-	  break;	/* Use first valid eqv expr for root exp/sym. */
-	}
-      if (root_sym != NULL)
-	break;
-    }
-
-  if (root_sym == NULL)
-    {
-      ffeequiv_destroy_ (eq);
-      return;
-    }
-
-
-#if FFEEQUIV_DEBUG
-  fprintf (stderr, "  Root: `%s'\n", ffesymbol_text (root_sym));
-#endif
-
-  /* We've got work to do, so make the LOCAL storage object that'll hold all
-     the equivalenced vars inside it. */
-
-  st = ffestorag_new (ffestorag_list_master ());
-  ffestorag_set_parent (st, NULL);	/* Initializations happen here. */
-  ffestorag_set_init (st, NULL);
-  ffestorag_set_accretion (st, NULL);
-  ffestorag_set_offset (st, 0);		/* Assume equiv will be at root offset 0 for now. */
-  ffestorag_set_alignment (st, 1);
-  ffestorag_set_modulo (st, 0);
-  ffestorag_set_type (st, FFESTORAG_typeLOCAL);
-  ffestorag_set_basictype (st, ffesymbol_basictype (root_sym));
-  ffestorag_set_kindtype (st, ffesymbol_kindtype (root_sym));
-  ffestorag_set_typesymbol (st, root_sym);
-  ffestorag_set_is_save (st, ffeequiv_is_save (eq));
-  if (ffesymbol_is_save (root_sym))
-    ffestorag_update_save (st);
-  ffestorag_set_is_init (st, ffeequiv_is_init (eq));
-  if (ffesymbol_is_init (root_sym))
-    ffestorag_update_init (st);
-  ffestorag_set_symbol (st, root_sym);	/* Assume this will be the root until
-					   we know better (used only to generate
-					   the internal name for the aggregate area,
-					   e.g. for debugging). */
-
-  /* Make the EQUIV storage object for the root symbol. */
-
-  if (ffesymbol_rank (root_sym) == 0)
-    num_elements = 1;
-  else
-    num_elements = ffebld_constant_integerdefault (ffebld_conter
-						(ffesymbol_arraysize (root_sym)));
-  ffetarget_layout (ffesymbol_text (root_sym), &alignment, &modulo, &size,
-		    ffesymbol_basictype (root_sym), ffesymbol_kindtype (root_sym),
-		    ffesymbol_size (root_sym), num_elements);
-  ffestorag_set_size (st, size);	/* Set initial size of aggregate area. */
-
-  pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
-			 ffestorag_ptr_to_modulo (st), 0, alignment,
-			 modulo);
-  assert (pad == 0);
-
-  root_st = ffestorag_new (ffestorag_list_equivs (st));
-  ffestorag_set_parent (root_st, st);	/* Initializations happen there. */
-  ffestorag_set_init (root_st, NULL);
-  ffestorag_set_accretion (root_st, NULL);
-  ffestorag_set_symbol (root_st, root_sym);
-  ffestorag_set_size (root_st, size);
-  ffestorag_set_offset (root_st, 0);	/* Will not change; always 0 relative to itself! */
-  ffestorag_set_alignment (root_st, alignment);
-  ffestorag_set_modulo (root_st, modulo);
-  ffestorag_set_type (root_st, FFESTORAG_typeEQUIV);
-  ffestorag_set_basictype (root_st, ffesymbol_basictype (root_sym));
-  ffestorag_set_kindtype (root_st, ffesymbol_kindtype (root_sym));
-  ffestorag_set_typesymbol (root_st, root_sym);
-  ffestorag_set_is_save (root_st, FALSE);	/* Assume FALSE, then... */
-  if (ffestorag_is_save (st))	/* ...update to TRUE if needed. */
-    ffestorag_update_save (root_st);
-  ffestorag_set_is_init (root_st, FALSE);	/* Assume FALSE, then... */
-  if (ffestorag_is_init (st))	/* ...update to TRUE if needed. */
-    ffestorag_update_init (root_st);
-  ffesymbol_set_storage (root_sym, root_st);
-  ffesymbol_signal_unreported (root_sym);
-  init = ffesymbol_is_init (root_sym);
-
-  /* Now that we know the root (offset=0) symbol, revisit all the lists and
-     do the actual storage allocation.	Keep doing this until we've gone
-     through them all without making any new storage objects. */
-
-  do
-    {
-      new_storage = FALSE;
-      need_storage = FALSE;
-      for (list = ffeequiv_list (eq);
-	   list != NULL;
-	   list = ffebld_trail (list))
-	{			/* For every equivalence list in the list of
-				   equivs */
-	  /* Now find a "rooted" symbol in this list.  That is, find the
-	     first item we can that is valid and whose symbol already
-	     has a storage area, because that means we know where it
-	     belongs in the equivalence area and can then allocate the
-	     rest of the items in the list accordingly.  */
-
-	  rooted_sym = NULL;
-	  rooted_exp = NULL;
-	  eqlist_offset = 0;
-
-	  for (item = ffebld_head (list);
-	       item != NULL;
-	       item = ffebld_trail (item))
-	    {			/* For every equivalence item in the list */
-	      rooted_exp = ffebld_head (item);
-	      rooted_sym = ffeequiv_symbol (rooted_exp);
-	      if ((rooted_sym == NULL)
-		  || ((rooted_st = ffesymbol_storage (rooted_sym)) == NULL))
-		{
-		  rooted_sym = NULL;
-		  continue;	/* Ignore me. */
-		}
-
-	      need_storage = TRUE;	/* Somebody is likely to need
-					   storage. */
-
-#if FFEEQUIV_DEBUG
-	      fprintf (stderr, "  Rooted: `%s' at %" ffetargetOffset_f "d\n",
-		       ffesymbol_text (rooted_sym),
-		       ffestorag_offset (rooted_st));
-#endif
-
-	      /* The offset of this symbol from the equiv's root symbol
-		 is already known, and the size of this symbol is already
-		 incorporated in the size of the equiv's aggregate area.
-		 What we now determine is the offset of this equivalence
-		 _list_ from the equiv's root symbol.
-
-		 For example, if we know that A is at offset 16 from the
-		 root symbol, given EQUIVALENCE (B(24),A(2)), we're looking
-		 at A(2), meaning that the offset for this equivalence list
-		 is 20 (4 bytes beyond the beginning of A, assuming typical
-		 array types, dimensions, and type info).  */
-
-	      if (!ffeequiv_offset_ (&eqlist_offset, rooted_sym, rooted_exp, FALSE,
-				     ffestorag_offset (rooted_st), FALSE))
-
-		{	/* Can't use this one. */
-		  ffesymbol_set_equiv (rooted_sym, NULL);/* Equiv area slated for
-							    death. */
-		  rooted_sym = NULL;
-		  continue;		/* Something's wrong with eqv expr, try another. */
-		}
-
-#if FFEEQUIV_DEBUG
-	      fprintf (stderr, "  Eqlist offset: %" ffetargetOffset_f "d\n",
-		       eqlist_offset);
-#endif
-
-	      break;
-	    }
-
-	  /* If no rooted symbol, it means this list has no roots -- yet.
-	     So, forget this list this time around, but we'll get back
-	     to it after the outer loop iterates at least one more time,
-	     and, ultimately, it will have a root.  */
-
-	  if (rooted_sym == NULL)
-	    {
-#if FFEEQUIV_DEBUG
-	      fprintf (stderr, "No roots.\n");
-#endif
-	      continue;
-	    }
-
-	  /* We now have a rooted symbol/expr and the offset of this equivalence
-	     list from the root symbol.  The other expressions in this
-	     list all identify an initial storage unit that must have the
-	     same offset. */
-
-	  for (item = ffebld_head (list);
-	       item != NULL;
-	       item = ffebld_trail (item))
-	    {			/* For every equivalence item in the list */
-	      ffebld item_exp;			/* Expression for equivalence. */
-	      ffestorag item_st;		/* Storage for var. */
-	      ffesymbol item_sym;		/* Var itself. */
-	      ffetargetOffset item_offset;	/* Offset for var from root. */
-	      ffetargetOffset new_size;
-
-	      item_exp = ffebld_head (item);
-	      item_sym = ffeequiv_symbol (item_exp);
-	      if ((item_sym == NULL)
-		  || (ffesymbol_equiv (item_sym) == NULL))
-		continue;	/* Ignore me. */
-
-	      if (item_sym == rooted_sym)
-		continue;	/* Rooted sym already set up. */
-
-	      if (!ffeequiv_offset_ (&item_offset, item_sym, item_exp, TRUE,
-				     eqlist_offset, FALSE))
-		{
-		  ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
-		  continue;
-		}
-
-#if FFEEQUIV_DEBUG
-	      fprintf (stderr, "  Item `%s' at %" ffetargetOffset_f "d",
-		       ffesymbol_text (item_sym), item_offset);
-#endif
-
-	      if (ffesymbol_rank (item_sym) == 0)
-		num_elements = 1;
-	      else
-		num_elements = ffebld_constant_integerdefault (ffebld_conter
-						(ffesymbol_arraysize (item_sym)));
-	      ffetarget_layout (ffesymbol_text (item_sym), &alignment, &modulo,
-				&size, ffesymbol_basictype (item_sym),
-				ffesymbol_kindtype (item_sym), ffesymbol_size (item_sym),
-				num_elements);
-	      pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
-				     ffestorag_ptr_to_modulo (st),
-				     item_offset, alignment, modulo);
-	      if (pad != 0)
-		{
-		  ffebad_start (FFEBAD_EQUIV_ALIGN);
-		  ffebad_string (ffesymbol_text (item_sym));
-		  ffebad_finish ();
-		  ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
-		  continue;
-		}
-
-	      /* If the variable's offset is less than the offset for the
-		 aggregate storage area, it means it has to expand backwards
-		 -- i.e. the new known starting point of the area precedes the
-		 old one.  This can't happen with COMMON areas (the standard,
-		 and common sense, disallow it), but it is normal for local
-		 EQUIVALENCE areas.
-
-		 Also handle choosing the "documented" rooted symbol for this
-		 area here.  It's the symbol at the bottom (lowest offset)
-		 of the aggregate area, with ties going to the name that would
-		 sort to the top of the list of ties.  */
-
-	      if (item_offset == ffestorag_offset (st))
-		{
-		  if ((item_sym != ffestorag_symbol (st))
-		      && (strcmp (ffesymbol_text (item_sym),
-				  ffesymbol_text (ffestorag_symbol (st)))
-			  < 0))
-		    ffestorag_set_symbol (st, item_sym);
-		}
-	      else if (item_offset < ffestorag_offset (st))
-		{
-		  /* Increase size of equiv area to start for lower offset
-		     relative to root symbol.  */
-		  if (! ffetarget_offset_add (&new_size,
-					      ffestorag_offset (st)
-					      - item_offset,
-					      ffestorag_size (st)))
-		    ffetarget_offset_overflow (ffesymbol_text (s));
-		  else
-		    ffestorag_set_size (st, new_size);
-
-		  ffestorag_set_symbol (st, item_sym);
-		  ffestorag_set_offset (st, item_offset);
-
-#if FFEEQUIV_DEBUG
-		  fprintf (stderr, " [eq offset=%" ffetargetOffset_f
-			   "d, size=%" ffetargetOffset_f "d]",
-			   item_offset, new_size);
-#endif
-		}
-
-	      if ((item_st = ffesymbol_storage (item_sym)) == NULL)
-		{		/* Create new ffestorag object, extend equiv
-				   area. */
-#if FFEEQUIV_DEBUG
-		  fprintf (stderr, ".\n");
-#endif
-		  new_storage = TRUE;
-		  item_st = ffestorag_new (ffestorag_list_equivs (st));
-		  ffestorag_set_parent (item_st, st);	/* Initializations
-							   happen there. */
-		  ffestorag_set_init (item_st, NULL);
-		  ffestorag_set_accretion (item_st, NULL);
-		  ffestorag_set_symbol (item_st, item_sym);
-		  ffestorag_set_size (item_st, size);
-		  ffestorag_set_offset (item_st, item_offset);
-		  ffestorag_set_alignment (item_st, alignment);
-		  ffestorag_set_modulo (item_st, modulo);
-		  ffestorag_set_type (item_st, FFESTORAG_typeEQUIV);
-		  ffestorag_set_basictype (item_st, ffesymbol_basictype (item_sym));
-		  ffestorag_set_kindtype (item_st, ffesymbol_kindtype (item_sym));
-		  ffestorag_set_typesymbol (item_st, item_sym);
-		  ffestorag_set_is_save (item_st, FALSE);	/* Assume FALSE... */
-		  if (ffestorag_is_save (st))	/* ...update TRUE */
-		    ffestorag_update_save (item_st);	/* if needed. */
-		  ffestorag_set_is_init (item_st, FALSE);	/* Assume FALSE... */
-		  if (ffestorag_is_init (st))	/* ...update TRUE */
-		    ffestorag_update_init (item_st);	/* if needed. */
-		  ffesymbol_set_storage (item_sym, item_st);
-		  ffesymbol_signal_unreported (item_sym);
-		  if (ffesymbol_is_init (item_sym))
-		    init = TRUE;
-
-		  /* Determine new size of equiv area, complain if overflow.  */
-
-		  if (!ffetarget_offset_add (&size, item_offset, size)
-		      || !ffetarget_offset_add (&size, -ffestorag_offset (st), size))
-		    ffetarget_offset_overflow (ffesymbol_text (s));
-		  else if (size > ffestorag_size (st))
-		    ffestorag_set_size (st, size);
-		  ffestorag_update (st, item_sym, ffesymbol_basictype (item_sym),
-				    ffesymbol_kindtype (item_sym));
-		}
-	      else
-		{
-#if FFEEQUIV_DEBUG
-		  fprintf (stderr, " (was %" ffetargetOffset_f "d).\n",
-			   ffestorag_offset (item_st));
-#endif
-		  /* Make sure offset agrees with known offset. */
-		  if (item_offset != ffestorag_offset (item_st))
-		    {
-		      char io1[40];
-		      char io2[40];
-
-		      sprintf (&io1[0], "%" ffetargetOffset_f "d", item_offset);
-		      sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (item_st));
-		      ffebad_start (FFEBAD_EQUIV_MISMATCH);
-		      ffebad_string (ffesymbol_text (item_sym));
-		      ffebad_string (ffesymbol_text (root_sym));
-		      ffebad_string (io1);
-		      ffebad_string (io2);
-		      ffebad_finish ();
-		    }
-		}
-	      ffesymbol_set_equiv (item_sym, NULL);	/* Don't bother with me anymore. */
-	    }			/* (For every equivalence item in the list) */
-	  ffebld_set_head (list, NULL);	/* Don't do this list again. */
-	}			/* (For every equivalence list in the list of
-				   equivs) */
-    } while (new_storage && need_storage);
-
-  ffesymbol_set_equiv (root_sym, NULL);	/* This one has storage now. */
-
-  ffeequiv_kill (eq);		/* Fully processed, no longer needed. */
-
-  /* If the offset for this storage area is zero (it cannot be positive),
-     that means the alignment/modulo info is already correct.  Otherwise,
-     the alignment info is correct, but the modulo info reflects a
-     zero offset, so fix it.  */
-
-  if (ffestorag_offset (st) < 0)
-    {
-      /* Calculate the initial padding necessary to preserve
-	 the alignment/modulo requirements for the storage area.
-	 These requirements are themselves kept track of in the
-	 record for the storage area as a whole, but really pertain
-	 to offset 0 of that area, which is where the root symbol
-	 was originally placed.
-
-	 The goal here is to have the offset and size for the area
-	 faithfully reflect the area itself, not extra requirements
-	 like alignment.  So to meet the alignment requirements,
-	 the modulo for the area should be set as if the area had an
-	 alignment requirement of alignment/0 and was aligned/padded
-	 downward to meet the alignment requirements of the area at
-	 offset zero, the amount of padding needed being the desired
-	 value for the modulo of the area.  */
-
-      alignment = ffestorag_alignment (st);
-      modulo = ffestorag_modulo (st);
-
-      /* Since we want to move the whole area *down* (lower memory
-	 addresses) as required by the alignment/modulo paid, negate
-	 the offset to ffetarget_align, which assumes aligning *up*
-	 is desired.  */
-      pad = ffetarget_align (&alignment, &modulo,
-			     - ffestorag_offset (st),
-			     alignment, 0);
-      ffestorag_set_modulo (st, pad);
-    }
-
-  if (init)
-    ffedata_gather (st);	/* Gather subordinate inits into one init. */
-}
-
-/* ffeequiv_offset_ -- Determine offset from start of symbol
-
-   ffetargetOffset offset;
-   ffesymbol s;	 // Symbol for error reporting.
-   ffebld expr;	 // opSUBSTR, opARRAYREF, opSYMTER, opANY.
-   bool subtract;  // FALSE means add to adjust, TRUE means subtract from it.
-   ffetargetOffset adjust;  // Helps keep answer in pos range (unsigned).
-   if (!ffeequiv_offset_(&offset,s,expr,subtract,adjust))
-       // error doing the calculation, message already printed
-
-   Returns the offset represented by the SUBSTR, ARRAYREF, or SUBSTR/ARRAYREF
-   combination added-to/subtracted-from the adjustment specified.  If there
-   is an error of some kind, returns FALSE, else returns TRUE.	Note that
-   only the first storage unit specified is considered; A(1:1) and A(1:2000)
-   have the same first storage unit and so return the same offset.  */
-
-static bool
-ffeequiv_offset_ (ffetargetOffset *offset, ffesymbol s UNUSED,
-		  ffebld expr, bool subtract, ffetargetOffset adjust,
-		  bool no_precede)
-{
-  ffetargetIntegerDefault value = 0;
-  ffetargetOffset cval;		/* Converted value. */
-  ffesymbol sym;
-
-  if (expr == NULL)
-    return FALSE;
-
-again:				/* :::::::::::::::::::: */
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opANY:
-      return FALSE;
-
-    case FFEBLD_opSYMTER:
-      {
-	ffetargetOffset size;	/* Size of a single unit. */
-	ffetargetAlign a;	/* Ignored. */
-	ffetargetAlign m;	/* Ignored. */
-
-	sym = ffebld_symter (expr);
-	if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
-	  return FALSE;
-
-	ffetarget_layout (ffesymbol_text (sym), &a, &m, &size,
-			  ffesymbol_basictype (sym),
-			  ffesymbol_kindtype (sym), 1, 1);
-
-	if (value < 0)
-	  {			/* Really invalid, as in A(-2:5), but in case
-				   it's wanted.... */
-	    if (!ffetarget_offset (&cval, -value))
-	      return FALSE;
-
-	    if (!ffetarget_offset_multiply (&cval, cval, size))
-	      return FALSE;
-
-	    if (subtract)
-	      return ffetarget_offset_add (offset, cval, adjust);
-
-	    if (no_precede && (cval > adjust))
-	      {
-	      neg:		/* :::::::::::::::::::: */
-		ffebad_start (FFEBAD_COMMON_NEG);
-		ffebad_string (ffesymbol_text (sym));
-		ffebad_finish ();
-		return FALSE;
-	      }
-	    return ffetarget_offset_add (offset, -cval, adjust);
-	  }
-
-	if (!ffetarget_offset (&cval, value))
-	  return FALSE;
-
-	if (!ffetarget_offset_multiply (&cval, cval, size))
-	  return FALSE;
-
-	if (!subtract)
-	  return ffetarget_offset_add (offset, cval, adjust);
-
-	if (no_precede && (cval > adjust))
-	  goto neg;		/* :::::::::::::::::::: */
-
-	return ffetarget_offset_add (offset, -cval, adjust);
-      }
-
-    case FFEBLD_opARRAYREF:
-      {
-	ffebld symexp = ffebld_left (expr);
-	ffebld subscripts = ffebld_right (expr);
-	ffebld dims;
-	ffetargetIntegerDefault width;
-	ffetargetIntegerDefault arrayval;
-	ffetargetIntegerDefault lowbound;
-	ffetargetIntegerDefault highbound;
-	ffebld subscript;
-	ffebld dim;
-	ffebld low;
-	ffebld high;
-	int rank = 0;
-
-	if (ffebld_op (symexp) != FFEBLD_opSYMTER)
-	  return FALSE;
-
-	sym = ffebld_symter (symexp);
-	if (ffesymbol_basictype (sym) == FFEINFO_basictypeANY)
-	  return FALSE;
-
-	if (ffesymbol_size (sym) == FFETARGET_charactersizeNONE)
-	  width = 1;
-	else
-	  width = ffesymbol_size (sym);
-	dims = ffesymbol_dims (sym);
-
-	while (subscripts != NULL)
-	  {
-	    ++rank;
-	    if (dims == NULL)
-	      {
-		ffebad_start (FFEBAD_EQUIV_MANY);
-		ffebad_string (ffesymbol_text (sym));
-		ffebad_finish ();
-		return FALSE;
-	      }
-
-	    subscript = ffebld_head (subscripts);
-	    dim = ffebld_head (dims);
-
-	    if (ffebld_op (subscript) == FFEBLD_opANY)
-	      return FALSE;
-
-	    assert (ffebld_op (subscript) == FFEBLD_opCONTER);
-	    assert (ffeinfo_basictype (ffebld_info (subscript))
-		    == FFEINFO_basictypeINTEGER);
-	    assert (ffeinfo_kindtype (ffebld_info (subscript))
-		    == FFEINFO_kindtypeINTEGERDEFAULT);
-	    arrayval = ffebld_constant_integerdefault (ffebld_conter
-						       (subscript));
-
-	    if (ffebld_op (dim) == FFEBLD_opANY)
-	      return FALSE;
-
-	    assert (ffebld_op (dim) == FFEBLD_opBOUNDS);
-	    low = ffebld_left (dim);
-	    high = ffebld_right (dim);
-
-	    if (low == NULL)
-	      lowbound = 1;
-	    else
-	      {
-		if (ffebld_op (low) == FFEBLD_opANY)
-		  return FALSE;
-
-		assert (ffebld_op (low) == FFEBLD_opCONTER);
-		assert (ffeinfo_basictype (ffebld_info (low))
-			== FFEINFO_basictypeINTEGER);
-		assert (ffeinfo_kindtype (ffebld_info (low))
-			== FFEINFO_kindtypeINTEGERDEFAULT);
-		lowbound
-		  = ffebld_constant_integerdefault (ffebld_conter (low));
-	      }
-
-	    if (ffebld_op (high) == FFEBLD_opANY)
-	      return FALSE;
-
-	    assert (ffebld_op (high) == FFEBLD_opCONTER);
-	    assert (ffeinfo_basictype (ffebld_info (high))
-		    == FFEINFO_basictypeINTEGER);
-	    assert (ffeinfo_kindtype (ffebld_info (high))
-		    == FFEINFO_kindtypeINTEGER1);
-	    highbound
-	      = ffebld_constant_integerdefault (ffebld_conter (high));
-
-	    if ((arrayval < lowbound) || (arrayval > highbound))
-	      {
-		char rankstr[10];
-
-		sprintf (rankstr, "%d", rank);
-		ffebad_start (FFEBAD_EQUIV_SUBSCRIPT);
-		ffebad_string (ffesymbol_text (sym));
-		ffebad_string (rankstr);
-		ffebad_finish ();
-	      }
-
-	    subscripts = ffebld_trail (subscripts);
-	    dims = ffebld_trail (dims);
-
-	    value += width * (arrayval - lowbound);
-	    if (subscripts != NULL)
-	      width *= highbound - lowbound + 1;
-	  }
-
-	if (dims != NULL)
-	  {
-	    ffebad_start (FFEBAD_EQUIV_FEW);
-	    ffebad_string (ffesymbol_text (sym));
-	    ffebad_finish ();
-	    return FALSE;
-	  }
-
-	expr = symexp;
-      }
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opSUBSTR:
-      {
-	ffebld begin = ffebld_head (ffebld_right (expr));
-
-	expr = ffebld_left (expr);
-	if (ffebld_op (expr) == FFEBLD_opANY)
-	  return FALSE;
-	if (ffebld_op (expr) == FFEBLD_opARRAYREF)
-	  sym = ffebld_symter (ffebld_left (expr));
-	else if (ffebld_op (expr) == FFEBLD_opSYMTER)
-	  sym = ffebld_symter (expr);
-	else
-	  sym = NULL;
-
-	if ((sym != NULL)
-	    && (ffesymbol_basictype (sym) == FFEINFO_basictypeANY))
-	  return FALSE;
-
-	if (begin == NULL)
-	  value = 0;
-	else
-	  {
-	    if (ffebld_op (begin) == FFEBLD_opANY)
-	      return FALSE;
-	    assert (ffebld_op (begin) == FFEBLD_opCONTER);
-	    assert (ffeinfo_basictype (ffebld_info (begin))
-		    == FFEINFO_basictypeINTEGER);
-	    assert (ffeinfo_kindtype (ffebld_info (begin))
-		    == FFEINFO_kindtypeINTEGERDEFAULT);
-
-	    value = ffebld_constant_integerdefault (ffebld_conter (begin));
-
-	    if ((value < 1)
-		|| ((sym != NULL)
-		    && (value > ffesymbol_size (sym))))
-	      {
-		ffebad_start (FFEBAD_EQUIV_RANGE);
-		ffebad_string (ffesymbol_text (sym));
-		ffebad_finish ();
-	      }
-
-	    --value;
-	  }
-	if ((sym != NULL)
-	    && (ffesymbol_basictype (sym) != FFEINFO_basictypeCHARACTER))
-	  {
-	    ffebad_start (FFEBAD_EQUIV_SUBSTR);
-	    ffebad_string (ffesymbol_text (sym));
-	    ffebad_finish ();
-	    value = 0;
-	  }
-      }
-      goto again;		/* :::::::::::::::::::: */
-
-    default:
-      assert ("bad op" == NULL);
-      return FALSE;
-    }
-
-}
-
-/* ffeequiv_add -- Add list of equivalences to list of lists for eq object
-
-   ffeequiv eq;
-   ffebld list;
-   ffelexToken t;  // points to first item in equivalence list
-   ffeequiv_add(eq,list,t);
-
-   Check the list to make sure only one common symbol is involved (even
-   if multiple times) and agrees with the common symbol for the equivalence
-   object (or it has no common symbol until now).  Prepend (or append, it
-   doesn't matter) the list to the list of lists for the equivalence object.
-   Otherwise report an error and return.  */
-
-void
-ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t)
-{
-  ffebld item;
-  ffesymbol symbol;
-  ffesymbol common = ffeequiv_common (eq);
-
-  for (item = list; item != NULL; item = ffebld_trail (item))
-    {
-      symbol = ffeequiv_symbol (ffebld_head (item));
-
-      if (ffesymbol_common (symbol) != NULL)	/* Is symbol known in COMMON yet? */
-	{
-	  if (common == NULL)
-	    common = ffesymbol_common (symbol);
-	  else if (common != ffesymbol_common (symbol))
-	    {
-	      /* Yes, and symbol disagrees with others on the COMMON area. */
-	      ffebad_start (FFEBAD_EQUIV_COMMON);
-	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	      ffebad_string (ffesymbol_text (common));
-	      ffebad_string (ffesymbol_text (ffesymbol_common (symbol)));
-	      ffebad_finish ();
-	      return;
-	    }
-	}
-    }
-
-  if ((common != NULL)
-      && (ffeequiv_common (eq) == NULL))	/* Is COMMON involved already? */
-    ffeequiv_set_common (eq, common);	/* No, but it is now. */
-
-  for (item = list; item != NULL; item = ffebld_trail (item))
-    {
-      symbol = ffeequiv_symbol (ffebld_head (item));
-
-      if (ffesymbol_equiv (symbol) == NULL)
-	ffesymbol_set_equiv (symbol, eq);
-      else
-	assert (ffesymbol_equiv (symbol) == eq);
-
-      if (ffesymbol_common (symbol) == NULL)	/* Is symbol in a COMMON
-						   area? */
-	{			/* No (at least not yet). */
-	  if (ffesymbol_is_save (symbol))
-	    ffeequiv_update_save (eq);	/* EQUIVALENCE has >=1 SAVEd entity. */
-	  if (ffesymbol_is_init (symbol))
-	    ffeequiv_update_init (eq);	/* EQUIVALENCE has >=1 init'd entity. */
-	  continue;		/* Nothing more to do here. */
-	}
-
-#if FFEGLOBAL_ENABLED
-      if (ffesymbol_is_init (symbol))
-	ffeglobal_init_common (ffesymbol_common (symbol), t);
-#endif
-
-      if (ffesymbol_is_save (ffesymbol_common (symbol)))
-	ffeequiv_update_save (eq);	/* EQUIVALENCE is in a SAVEd COMMON block. */
-      if (ffesymbol_is_init (ffesymbol_common (symbol)))
-	ffeequiv_update_init (eq);	/* EQUIVALENCE is in a init'd COMMON block. */
-    }
-
-  ffeequiv_set_list (eq, ffebld_new_item (list, ffeequiv_list (eq)));
-}
-
-/* ffeequiv_exec_transition -- Do the hard work on all the equivalence objects
-
-   ffeequiv_exec_transition();	*/
-
-void
-ffeequiv_exec_transition (void)
-{
-  while (ffeequiv_list_.first != (ffeequiv) &ffeequiv_list_.first)
-    ffeequiv_layout_local_ (ffeequiv_list_.first);
-}
-
-/* ffeequiv_init_2 -- Initialize for new program unit
-
-   ffeequiv_init_2();
-
-   Initializes the list of equivalences.  */
-
-void
-ffeequiv_init_2 (void)
-{
-  ffeequiv_list_.first = (ffeequiv) &ffeequiv_list_.first;
-  ffeequiv_list_.last = (ffeequiv) &ffeequiv_list_.first;
-}
-
-/* ffeequiv_kill -- Kill equivalence object after removing from list
-
-   ffeequiv eq;
-   ffeequiv_kill(eq);
-
-   Removes equivalence object from master list, then kills it.	*/
-
-void
-ffeequiv_kill (ffeequiv victim)
-{
-  victim->next->previous = victim->previous;
-  victim->previous->next = victim->next;
-  if (ffe_is_do_internal_checks ())
-    {
-      ffebld list;
-      ffebld item;
-      ffebld expr;
-
-      /* Assert that nobody our victim points to still points to it.  */
-
-      assert ((victim->common == NULL)
-	      || (ffesymbol_equiv (victim->common) == NULL));
-
-      for (list = victim->list; list != NULL; list = ffebld_trail (list))
-	{
-	  for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
-	    {
-	      ffesymbol sym;
-
-	      expr = ffebld_head (item);
-	      sym = ffeequiv_symbol (expr);
-	      if (sym == NULL)
-		continue;
-	      assert (ffesymbol_equiv (sym) != victim);
-	    }
-	}
-    }
-  malloc_kill_ks (ffe_pool_program_unit (), victim, sizeof (*victim));
-}
-
-/* ffeequiv_layout_cblock -- Lay out storage for common area
-
-   ffestorag st;
-   if (ffeequiv_layout_cblock(st))
-       // at least one equiv'd symbol has init/accretion expr.
-
-   Now that the explicitly COMMONed variables in the common area (whose
-   ffestorag object is passed) have been laid out, lay out the storage
-   for all variables equivalenced into the area by making subordinate
-   ffestorag objects for them.	*/
-
-bool
-ffeequiv_layout_cblock (ffestorag st)
-{
-  ffesymbol s = ffestorag_symbol (st);	/* CBLOCK symbol. */
-  ffebld list;			/* List of explicit common vars, in order, in
-				   s. */
-  ffebld item;			/* List of list of equivalences in a given
-				   explicit common var. */
-  ffebld root;			/* Expression for (1st) explicit common var
-				   in list of eqs. */
-  ffestorag rst;		/* Storage for root. */
-  ffetargetOffset root_offset;	/* Offset for root into common area. */
-  ffesymbol sr;			/* Root itself. */
-  ffeequiv seq;			/* Its equivalence object, if any. */
-  ffebld var;			/* Expression for equivalence. */
-  ffestorag vst;		/* Storage for var. */
-  ffetargetOffset var_offset;	/* Offset for var into common area. */
-  ffesymbol sv;			/* Var itself. */
-  ffebld altroot;		/* Alternate root. */
-  ffesymbol altrootsym;		/* Alternate root symbol. */
-  ffetargetAlign alignment;
-  ffetargetAlign modulo;
-  ffetargetAlign pad;
-  ffetargetOffset size;
-  ffetargetOffset num_elements;
-  bool new_storage;		/* Established new storage info. */
-  bool need_storage;		/* Have need for more storage info. */
-  bool ok;
-  bool init = FALSE;
-
-  assert (st != NULL);
-  assert (ffestorag_type (st) == FFESTORAG_typeCBLOCK);
-  assert (ffesymbol_kind (ffestorag_symbol (st)) == FFEINFO_kindCOMMON);
-
-  for (list = ffesymbol_commonlist (ffestorag_symbol (st));
-       list != NULL;
-       list = ffebld_trail (list))
-    {				/* For every variable in the common area */
-      assert (ffebld_op (ffebld_head (list)) == FFEBLD_opSYMTER);
-      sr = ffebld_symter (ffebld_head (list));
-      if ((seq = ffesymbol_equiv (sr)) == NULL)
-	continue;		/* No equivalences to process. */
-      rst = ffesymbol_storage (sr);
-      if (rst == NULL)
-	{
-	  assert (ffesymbol_kind (sr) == FFEINFO_kindANY);
-	  continue;
-	}
-      ffesymbol_set_equiv (sr, NULL);	/* Cancel ref to equiv obj. */
-      do
-	{
-	  new_storage = FALSE;
-	  need_storage = FALSE;
-	  for (item = ffeequiv_list (seq);	/* Get list of equivs. */
-	       item != NULL;
-	       item = ffebld_trail (item))
-	    {			/* For every eqv list in the list of equivs
-				   for the variable */
-	      altroot = NULL;
-	      altrootsym = NULL;
-	      for (root = ffebld_head (item);
-		   root != NULL;
-		   root = ffebld_trail (root))
-		{		/* For every equivalence item in the list */
-		  sv = ffeequiv_symbol (ffebld_head (root));
-		  if (sv == sr)
-		    break;	/* Found first mention of "rooted" symbol. */
-		  if (ffesymbol_storage (sv) != NULL)
-		    {
-		      altroot = root;	/* If no mention, use this guy
-					   instead. */
-		      altrootsym = sv;
-		    }
-		}
-	      if (root != NULL)
-		{
-		  root = ffebld_head (root);	/* Lose its opITEM. */
-		  ok = ffeequiv_offset_ (&root_offset, sr, root, FALSE,
-					 ffestorag_offset (rst), TRUE);
-		  /* Equiv point prior to start of common area? */
-		}
-	      else if (altroot != NULL)
-		{
-		  /* Equiv point prior to start of common area? */
-		  root = ffebld_head (altroot);
-		  ok = ffeequiv_offset_ (&root_offset, altrootsym, root,
-					 FALSE,
-			 ffestorag_offset (ffesymbol_storage (altrootsym)),
-					 TRUE);
-		  ffesymbol_set_equiv (altrootsym, NULL);
-		}
-	      else
-		/* No rooted symbol in list of equivalences! */
-		{		/* Assume this was due to opANY and ignore
-				   this list for now. */
-		  need_storage = TRUE;
-		  continue;
-		}
-
-	      /* We now know the root symbol and the operating offset of that
-		 root into the common area.  The other expressions in the
-		 list all identify an initial storage unit that must have the
-		 same offset. */
-
-	      for (var = ffebld_head (item);
-		   var != NULL;
-		   var = ffebld_trail (var))
-		{		/* For every equivalence item in the list */
-		  if (ffebld_head (var) == root)
-		    continue;	/* Except root, of course. */
-		  sv = ffeequiv_symbol (ffebld_head (var));
-		  if (sv == NULL)
-		    continue;	/* Except erroneous stuff (opANY). */
-		  ffesymbol_set_equiv (sv, NULL);	/* Don't need this ref
-							   anymore. */
-		  if (!ok
-		      || !ffeequiv_offset_ (&var_offset, sv,
-					    ffebld_head (var), TRUE,
-					    root_offset, TRUE))
-		    continue;	/* Can't do negative offset wrt COMMON. */
-
-		  if (ffesymbol_rank (sv) == 0)
-		    num_elements = 1;
-		  else
-		    num_elements = ffebld_constant_integerdefault
-		      (ffebld_conter (ffesymbol_arraysize (sv)));
-		  ffetarget_layout (ffesymbol_text (sv), &alignment,
-				    &modulo, &size,
-				    ffesymbol_basictype (sv),
-				    ffesymbol_kindtype (sv),
-				    ffesymbol_size (sv), num_elements);
-		  pad = ffetarget_align (ffestorag_ptr_to_alignment (st),
-					 ffestorag_ptr_to_modulo (st),
-					 var_offset, alignment, modulo);
-		  if (pad != 0)
-		    {
-		      ffebad_start (FFEBAD_EQUIV_ALIGN);
-		      ffebad_string (ffesymbol_text (sv));
-		      ffebad_finish ();
-		      continue;
-		    }
-
-		  if ((vst = ffesymbol_storage (sv)) == NULL)
-		    {		/* Create new ffestorag object, extend
-				   cblock. */
-		      new_storage = TRUE;
-		      vst = ffestorag_new (ffestorag_list_equivs (st));
-		      ffestorag_set_parent (vst, st);	/* Initializations
-							   happen there. */
-		      ffestorag_set_init (vst, NULL);
-		      ffestorag_set_accretion (vst, NULL);
-		      ffestorag_set_symbol (vst, sv);
-		      ffestorag_set_size (vst, size);
-		      ffestorag_set_offset (vst, var_offset);
-		      ffestorag_set_alignment (vst, alignment);
-		      ffestorag_set_modulo (vst, modulo);
-		      ffestorag_set_type (vst, FFESTORAG_typeEQUIV);
-		      ffestorag_set_basictype (vst, ffesymbol_basictype (sv));
-		      ffestorag_set_kindtype (vst, ffesymbol_kindtype (sv));
-		      ffestorag_set_typesymbol (vst, sv);
-		      ffestorag_set_is_save (vst, FALSE);	/* Assume FALSE... */
-		      if (ffestorag_is_save (st))	/* ...update TRUE */
-			ffestorag_update_save (vst);	/* if needed. */
-		      ffestorag_set_is_init (vst, FALSE);	/* Assume FALSE... */
-		      if (ffestorag_is_init (st))	/* ...update TRUE */
-			ffestorag_update_init (vst);	/* if needed. */
-		      if (!ffetarget_offset_add (&size, var_offset, size))
-			/* Find one size of common block, complain if
-			   overflow. */
-			ffetarget_offset_overflow (ffesymbol_text (s));
-		      else if (size > ffestorag_size (st))
-			/* Extend common. */
-			ffestorag_set_size (st, size);
-		      ffesymbol_set_storage (sv, vst);
-		      ffesymbol_set_common (sv, s);
-		      ffesymbol_signal_unreported (sv);
-		      ffestorag_update (st, sv, ffesymbol_basictype (sv),
-					ffesymbol_kindtype (sv));
-		      if (ffesymbol_is_init (sv))
-			init = TRUE;
-		    }
-		  else
-		    {
-		      /* Make sure offset agrees with known offset. */
-		      if (var_offset != ffestorag_offset (vst))
-			{
-			  char io1[40];
-			  char io2[40];
-
-			  sprintf (&io1[0], "%" ffetargetOffset_f "d", var_offset);
-			  sprintf (&io2[0], "%" ffetargetOffset_f "d", ffestorag_offset (vst));
-			  ffebad_start (FFEBAD_EQUIV_MISMATCH);
-			  ffebad_string (ffesymbol_text (sv));
-			  ffebad_string (ffesymbol_text (s));
-			  ffebad_string (io1);
-			  ffebad_string (io2);
-			  ffebad_finish ();
-			}
-		    }
-		}		/* (For every equivalence item in the list) */
-	    }			/* (For every eqv list in the list of equivs
-				   for the variable) */
-	}
-      while (new_storage && need_storage);
-
-      ffeequiv_kill (seq);	/* Kill equiv obj. */
-    }				/* (For every variable in the common area) */
-
-  return init;
-}
-
-/* ffeequiv_merge -- Merge two equivalence objects, return the merged result
-
-   ffeequiv eq1;
-   ffeequiv eq2;
-   ffelexToken t;  // points to current equivalence item forcing the merge.
-   eq1 = ffeequiv_merge(eq1,eq2,t);
-
-   If the two equivalence objects can be merged, they are, all the
-   ffesymbols in their lists of lists are adjusted to point to the merged
-   equivalence object, and the merged object is returned.
-
-   Otherwise, the two equivalence objects have different non-NULL common
-   symbols, so the merge cannot take place.  An error message is issued and
-   NULL is returned.  */
-
-ffeequiv
-ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t)
-{
-  ffebld list;
-  ffebld eqs;
-  ffesymbol symbol;
-  ffebld last = NULL;
-
-  /* If both equivalence objects point to different common-based symbols,
-     complain.	Of course, one or both might have NULL common symbols now,
-     and get COMMONed later, but the COMMON statement handler checks for
-     this. */
-
-  if ((ffeequiv_common (eq1) != NULL) && (ffeequiv_common (eq2) != NULL)
-      && (ffeequiv_common (eq1) != ffeequiv_common (eq2)))
-    {
-      ffebad_start (FFEBAD_EQUIV_COMMON);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_string (ffesymbol_text (ffeequiv_common (eq1)));
-      ffebad_string (ffesymbol_text (ffeequiv_common (eq2)));
-      ffebad_finish ();
-      return NULL;
-    }
-
-  /* Make eq1 the new, merged object (arbitrarily). */
-
-  if (ffeequiv_common (eq1) == NULL)
-    ffeequiv_set_common (eq1, ffeequiv_common (eq2));
-
-  /* If the victim object has any init'ed entities, so does the new object. */
-
-  if (eq2->is_init)
-    eq1->is_init = TRUE;
-
-#if FFEGLOBAL_ENABLED
-  if (eq1->is_init && (ffeequiv_common (eq1) != NULL))
-    ffeglobal_init_common (ffeequiv_common (eq1), t);
-#endif
-
-  /* If the victim object has any SAVEd entities, then the new object has
-     some. */
-
-  if (ffeequiv_is_save (eq2))
-    ffeequiv_update_save (eq1);
-
-  /* If the victim object has any init'd entities, then the new object has
-     some. */
-
-  if (ffeequiv_is_init (eq2))
-    ffeequiv_update_init (eq1);
-
-  /* Adjust all the symbols in the list of lists of equivalences for the
-     victim equivalence object so they point to the new merged object
-     instead. */
-
-  for (list = ffeequiv_list (eq2); list != NULL; list = ffebld_trail (list))
-    {
-      for (eqs = ffebld_head (list); eqs != NULL; eqs = ffebld_trail (eqs))
-	{
-	  symbol = ffeequiv_symbol (ffebld_head (eqs));
-	  if (ffesymbol_equiv (symbol) == eq2)
-	    ffesymbol_set_equiv (symbol, eq1);
-	  else
-	    assert (ffesymbol_equiv (symbol) == eq1);	/* Can see a sym > once. */
-	}
-
-      /* For convenience, remember where the last ITEM in the outer list is. */
-
-      if (ffebld_trail (list) == NULL)
-	{
-	  last = list;
-	  break;
-	}
-    }
-
-  /* Append the list of lists in the new, merged object to the list of lists
-     in the victim object, then use the new combined list in the new merged
-     object. */
-
-  ffebld_set_trail (last, ffeequiv_list (eq1));
-  ffeequiv_set_list (eq1, ffeequiv_list (eq2));
-
-  /* Unlink and kill the victim object. */
-
-  ffeequiv_kill (eq2);
-
-  return eq1;			/* Return the new merged object. */
-}
-
-/* ffeequiv_new -- Create new equivalence object, put in list
-
-   ffeequiv eq;
-   eq = ffeequiv_new();
-
-   Creates a new equivalence object and adds it to the list of equivalence
-   objects.  */
-
-ffeequiv
-ffeequiv_new (void)
-{
-  ffeequiv eq;
-
-  eq = malloc_new_ks (ffe_pool_program_unit (), "ffeequiv", sizeof (*eq));
-  eq->next = (ffeequiv) &ffeequiv_list_.first;
-  eq->previous = ffeequiv_list_.last;
-  ffeequiv_set_common (eq, NULL);	/* No COMMON area yet. */
-  ffeequiv_set_list (eq, NULL);	/* No list of lists of equivalences yet. */
-  ffeequiv_set_is_save (eq, FALSE);
-  ffeequiv_set_is_init (eq, FALSE);
-  eq->next->previous = eq;
-  eq->previous->next = eq;
-
-  return eq;
-}
-
-/* ffeequiv_symbol -- Return symbol for equivalence expression
-
-   ffesymbol symbol;
-   ffebld expr;
-   symbol = ffeequiv_symbol(expr);
-
-   Finds the terminal SYMTER in an equivalence expression and returns the
-   ffesymbol for it.  */
-
-ffesymbol
-ffeequiv_symbol (ffebld expr)
-{
-  assert (expr != NULL);
-
-again:				/* :::::::::::::::::::: */
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opARRAYREF:
-    case FFEBLD_opSUBSTR:
-      expr = ffebld_left (expr);
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opSYMTER:
-      return ffebld_symter (expr);
-
-    case FFEBLD_opANY:
-      return NULL;
-
-    default:
-      assert ("bad eq expr" == NULL);
-      return NULL;
-    }
-}
-
-/* ffeequiv_update_init -- Update the INIT flag for the area to TRUE
-
-   ffeequiv eq;
-   ffeequiv_update_init(eq);
-
-   If the INIT flag for the <eq> object is already set, return.	 Else,
-   set it TRUE and call ffe*_update_init for all objects contained in
-   this one.  */
-
-void
-ffeequiv_update_init (ffeequiv eq)
-{
-  ffebld list;			/* Current list in list of lists. */
-  ffebld item;			/* Current item in current list. */
-  ffebld expr;			/* Expression in head of current item. */
-
-  if (eq->is_init)
-    return;
-
-  eq->is_init = TRUE;
-
-  if ((eq->common != NULL)
-      && !ffesymbol_is_init (eq->common))
-    ffesymbol_update_init (eq->common);	/* Shouldn't be needed. */
-
-  for (list = eq->list; list != NULL; list = ffebld_trail (list))
-    {
-      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
-	{
-	  expr = ffebld_head (item);
-
-	again:			/* :::::::::::::::::::: */
-
-	  switch (ffebld_op (expr))
-	    {
-	    case FFEBLD_opANY:
-	      break;
-
-	    case FFEBLD_opSYMTER:
-	      if (!ffesymbol_is_init (ffebld_symter (expr)))
-		ffesymbol_update_init (ffebld_symter (expr));
-	      break;
-
-	    case FFEBLD_opARRAYREF:
-	      expr = ffebld_left (expr);
-	      goto again;	/* :::::::::::::::::::: */
-
-	    case FFEBLD_opSUBSTR:
-	      expr = ffebld_left (expr);
-	      goto again;	/* :::::::::::::::::::: */
-
-	    default:
-	      assert ("bad op for ffeequiv_update_init" == NULL);
-	      break;
-	    }
-	}
-    }
-}
-
-/* ffeequiv_update_save -- Update the SAVE flag for the area to TRUE
-
-   ffeequiv eq;
-   ffeequiv_update_save(eq);
-
-   If the SAVE flag for the <eq> object is already set, return.	 Else,
-   set it TRUE and call ffe*_update_save for all objects contained in
-   this one.  */
-
-void
-ffeequiv_update_save (ffeequiv eq)
-{
-  ffebld list;			/* Current list in list of lists. */
-  ffebld item;			/* Current item in current list. */
-  ffebld expr;			/* Expression in head of current item. */
-
-  if (eq->is_save)
-    return;
-
-  eq->is_save = TRUE;
-
-  if ((eq->common != NULL)
-      && !ffesymbol_is_save (eq->common))
-    ffesymbol_update_save (eq->common);	/* Shouldn't be needed. */
-
-  for (list = eq->list; list != NULL; list = ffebld_trail (list))
-    {
-      for (item = ffebld_head (list); item != NULL; item = ffebld_trail (item))
-	{
-	  expr = ffebld_head (item);
-
-	again:			/* :::::::::::::::::::: */
-
-	  switch (ffebld_op (expr))
-	    {
-	    case FFEBLD_opANY:
-	      break;
-
-	    case FFEBLD_opSYMTER:
-	      if (!ffesymbol_is_save (ffebld_symter (expr)))
-		ffesymbol_update_save (ffebld_symter (expr));
-	      break;
-
-	    case FFEBLD_opARRAYREF:
-	      expr = ffebld_left (expr);
-	      goto again;	/* :::::::::::::::::::: */
-
-	    case FFEBLD_opSUBSTR:
-	      expr = ffebld_left (expr);
-	      goto again;	/* :::::::::::::::::::: */
-
-	    default:
-	      assert ("bad op for ffeequiv_update_save" == NULL);
-	      break;
-	    }
-	}
-    }
-}
diff --git a/gcc/f/equiv.h b/gcc/f/equiv.h
deleted file mode 100644
index 59abfc8..0000000
--- a/gcc/f/equiv.h
+++ /dev/null
@@ -1,100 +0,0 @@
-/* equiv.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      equiv.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_EQUIV_H
-#define GCC_F_EQUIV_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-typedef struct _ffeequiv_ *ffeequiv;
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "lex.h"
-#include "storag.h"
-#include "symbol.h"
-
-/* Structure definitions. */
-
-struct _ffeequiv_
-  {
-    ffeequiv next;
-    ffeequiv previous;
-    ffesymbol common;		/* Common area for this equiv, if any. */
-    ffebld list;		/* List of lists of equiv exprs. */
-    bool is_save;		/* Any SAVEd members? */
-    bool is_init;		/* Any initialized members? */
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffeequiv_add (ffeequiv eq, ffebld list, ffelexToken t);
-void ffeequiv_exec_transition (void);
-void ffeequiv_init_2 (void);
-void ffeequiv_kill (ffeequiv victim);
-bool ffeequiv_layout_cblock (ffestorag st);
-ffeequiv ffeequiv_merge (ffeequiv eq1, ffeequiv eq2, ffelexToken t);
-ffeequiv ffeequiv_new (void);
-ffesymbol ffeequiv_symbol (ffebld expr);
-void ffeequiv_update_init (ffeequiv eq);
-void ffeequiv_update_save (ffeequiv eq);
-
-/* Define macros. */
-
-#define ffeequiv_common(e) ((e)->common)
-#define ffeequiv_init_0()
-#define ffeequiv_init_1()
-#define ffeequiv_init_3()
-#define ffeequiv_init_4()
-#define ffeequiv_is_init(e) ((e)->is_init)
-#define ffeequiv_is_save(e) ((e)->is_save)
-#define ffeequiv_list(e) ((e)->list)
-#define ffeequiv_next(e) ((e)->next)
-#define ffeequiv_previous(e) ((e)->previous)
-#define ffeequiv_set_common(e,c) ((e)->common = (c))
-#define ffeequiv_set_init(e,i) ((e)->init = (i))
-#define ffeequiv_set_is_init(e,in) ((e)->is_init = (in))
-#define ffeequiv_set_is_save(e,sa) ((e)->is_save = (sa))
-#define ffeequiv_set_list(e,l) ((e)->list = (l))
-#define ffeequiv_terminate_0()
-#define ffeequiv_terminate_1()
-#define ffeequiv_terminate_2()
-#define ffeequiv_terminate_3()
-#define ffeequiv_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_EQUIV_H */
diff --git a/gcc/f/expr.c b/gcc/f/expr.c
deleted file mode 100644
index ef7661d..0000000
--- a/gcc/f/expr.c
+++ /dev/null
@@ -1,18571 +0,0 @@
-/* expr.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None.
-
-   Description:
-      Handles syntactic and semantic analysis of Fortran expressions.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "expr.h"
-#include "bad.h"
-#include "bld.h"
-#include "com.h"
-#include "global.h"
-#include "implic.h"
-#include "intrin.h"
-#include "info.h"
-#include "lex.h"
-#include "malloc.h"
-#include "src.h"
-#include "st.h"
-#include "symbol.h"
-#include "str.h"
-#include "target.h"
-#include "where.h"
-#include "real.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFEEXPR_exprtypeUNKNOWN_,
-    FFEEXPR_exprtypeOPERAND_,
-    FFEEXPR_exprtypeUNARY_,
-    FFEEXPR_exprtypeBINARY_,
-    FFEEXPR_exprtype_
-  } ffeexprExprtype_;
-
-typedef enum
-  {
-    FFEEXPR_operatorPOWER_,
-    FFEEXPR_operatorMULTIPLY_,
-    FFEEXPR_operatorDIVIDE_,
-    FFEEXPR_operatorADD_,
-    FFEEXPR_operatorSUBTRACT_,
-    FFEEXPR_operatorCONCATENATE_,
-    FFEEXPR_operatorLT_,
-    FFEEXPR_operatorLE_,
-    FFEEXPR_operatorEQ_,
-    FFEEXPR_operatorNE_,
-    FFEEXPR_operatorGT_,
-    FFEEXPR_operatorGE_,
-    FFEEXPR_operatorNOT_,
-    FFEEXPR_operatorAND_,
-    FFEEXPR_operatorOR_,
-    FFEEXPR_operatorXOR_,
-    FFEEXPR_operatorEQV_,
-    FFEEXPR_operatorNEQV_,
-    FFEEXPR_operator_
-  } ffeexprOperator_;
-
-typedef enum
-  {
-    FFEEXPR_operatorprecedenceHIGHEST_ = 1,
-    FFEEXPR_operatorprecedencePOWER_ = 1,
-    FFEEXPR_operatorprecedenceMULTIPLY_ = 2,
-    FFEEXPR_operatorprecedenceDIVIDE_ = 2,
-    FFEEXPR_operatorprecedenceADD_ = 3,
-    FFEEXPR_operatorprecedenceSUBTRACT_ = 3,
-    FFEEXPR_operatorprecedenceLOWARITH_ = 3,
-    FFEEXPR_operatorprecedenceCONCATENATE_ = 3,
-    FFEEXPR_operatorprecedenceLT_ = 4,
-    FFEEXPR_operatorprecedenceLE_ = 4,
-    FFEEXPR_operatorprecedenceEQ_ = 4,
-    FFEEXPR_operatorprecedenceNE_ = 4,
-    FFEEXPR_operatorprecedenceGT_ = 4,
-    FFEEXPR_operatorprecedenceGE_ = 4,
-    FFEEXPR_operatorprecedenceNOT_ = 5,
-    FFEEXPR_operatorprecedenceAND_ = 6,
-    FFEEXPR_operatorprecedenceOR_ = 7,
-    FFEEXPR_operatorprecedenceXOR_ = 8,
-    FFEEXPR_operatorprecedenceEQV_ = 8,
-    FFEEXPR_operatorprecedenceNEQV_ = 8,
-    FFEEXPR_operatorprecedenceLOWEST_ = 8,
-    FFEEXPR_operatorprecedence_
-  } ffeexprOperatorPrecedence_;
-
-#define FFEEXPR_operatorassociativityL2R_ TRUE
-#define FFEEXPR_operatorassociativityR2L_ FALSE
-#define FFEEXPR_operatorassociativityPOWER_ FFEEXPR_operatorassociativityR2L_
-#define FFEEXPR_operatorassociativityMULTIPLY_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityDIVIDE_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityADD_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativitySUBTRACT_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityCONCATENATE_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityLT_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityLE_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityEQ_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityNE_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityGT_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityGE_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityNOT_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityAND_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityOR_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityXOR_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityEQV_ FFEEXPR_operatorassociativityL2R_
-#define FFEEXPR_operatorassociativityNEQV_ FFEEXPR_operatorassociativityL2R_
-
-typedef enum
-  {
-    FFEEXPR_parentypeFUNCTION_,
-    FFEEXPR_parentypeSUBROUTINE_,
-    FFEEXPR_parentypeARRAY_,
-    FFEEXPR_parentypeSUBSTRING_,
-    FFEEXPR_parentypeFUNSUBSTR_,/* Ambig: check for colon after first expr. */
-    FFEEXPR_parentypeEQUIVALENCE_,	/* Ambig: ARRAY_ or SUBSTRING_. */
-    FFEEXPR_parentypeANY_,	/* Allow basically anything. */
-    FFEEXPR_parentype_
-  } ffeexprParenType_;
-
-typedef enum
-  {
-    FFEEXPR_percentNONE_,
-    FFEEXPR_percentLOC_,
-    FFEEXPR_percentVAL_,
-    FFEEXPR_percentREF_,
-    FFEEXPR_percentDESCR_,
-    FFEEXPR_percent_
-  } ffeexprPercent_;
-
-/* Internal typedefs. */
-
-typedef struct _ffeexpr_expr_ *ffeexprExpr_;
-typedef bool ffeexprOperatorAssociativity_;
-typedef struct _ffeexpr_stack_ *ffeexprStack_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffeexpr_expr_
-  {
-    ffeexprExpr_ previous;
-    ffelexToken token;
-    ffeexprExprtype_ type;
-    union
-      {
-	struct
-	  {
-	    ffeexprOperator_ op;
-	    ffeexprOperatorPrecedence_ prec;
-	    ffeexprOperatorAssociativity_ as;
-	  }
-	operator;
-	ffebld operand;
-      }
-    u;
-  };
-
-struct _ffeexpr_stack_
-  {
-    ffeexprStack_ previous;
-    mallocPool pool;
-    ffeexprContext context;
-    ffeexprCallback callback;
-    ffelexToken first_token;
-    ffeexprExpr_ exprstack;
-    ffelexToken tokens[10];	/* Used in certain cases, like (unary)
-				   open-paren. */
-    ffebld expr;		/* For first of
-				   complex/implied-do/substring/array-elements
-				   / actual-args expression. */
-    ffebld bound_list;		/* For tracking dimension bounds list of
-				   array. */
-    ffebldListBottom bottom;	/* For building lists. */
-    ffeinfoRank rank;		/* For elements in an array reference. */
-    bool constant;		/* TRUE while elements seen so far are
-				   constants. */
-    bool immediate;		/* TRUE while elements seen so far are
-				   immediate/constants. */
-    ffebld next_dummy;		/* Next SFUNC dummy arg in arg list. */
-    ffebldListLength num_args;	/* Number of dummy args expected in arg list. */
-    bool is_rhs;		/* TRUE if rhs context, FALSE otherwise. */
-    ffeexprPercent_ percent;	/* Current %FOO keyword. */
-  };
-
-struct _ffeexpr_find_
-  {
-    ffelexToken t;
-    ffelexHandler after;
-    int level;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-static ffeexprStack_ ffeexpr_stack_;	/* Expression stack for semantic. */
-static ffelexToken ffeexpr_tokens_[10];	/* Scratchpad tokens for syntactic. */
-static ffestrOther ffeexpr_current_dotdot_;	/* Current .FOO. keyword. */
-static long ffeexpr_hollerith_count_;	/* ffeexpr_token_number_ and caller. */
-static int ffeexpr_level_;	/* Level of DATA implied-DO construct. */
-static bool ffeexpr_is_substr_ok_;	/* If OPEN_PAREN as binary "op" ok. */
-static struct _ffeexpr_find_ ffeexpr_find_;
-
-/* Static functions (internal). */
-
-static ffelexHandler ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr,
-					      ffelexToken t);
-static ffelexHandler ffeexpr_cb_close_paren_ambig_ (ffelexToken ft,
-						    ffebld expr,
-						    ffelexToken t);
-static ffelexHandler ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t);
-static ffelexHandler ffeexpr_cb_close_paren_c_ (ffelexToken ft,
-						ffebld expr, ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-static ffelexHandler ffeexpr_cb_close_paren_ci_ (ffelexToken ft,
-						 ffebld expr, ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr,
-					   ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr,
-					    ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_i_2_ (ffelexToken ft, ffebld expr,
-					    ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_i_3_ (ffelexToken ft, ffebld expr,
-					    ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_i_4_ (ffelexToken ft, ffebld expr,
-					    ffelexToken t);
-static ffelexHandler ffeexpr_cb_comma_i_5_ (ffelexToken t);
-static ffelexHandler ffeexpr_cb_end_loc_ (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-static ffelexHandler ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr,
-					     ffelexToken t);
-static ffelexHandler ffeexpr_cb_end_notloc_1_ (ffelexToken t);
-static ffesymbol ffeexpr_check_impctrl_ (ffesymbol s);
-static void ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
-				  ffebld dovar, ffelexToken dovar_t);
-static void ffeexpr_update_impdo_ (ffebld expr, ffebld dovar);
-static void ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar);
-static ffeexprContext ffeexpr_context_outer_ (ffeexprStack_ s);
-static ffeexprExpr_ ffeexpr_expr_new_ (void);
-static void ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t);
-static bool ffeexpr_isdigits_ (const char *p);
-static ffelexHandler ffeexpr_token_first_lhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_lhs_1_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_1_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_2_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_3_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_4_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_5_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_first_rhs_6_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_namelist_ (ffelexToken t);
-static void ffeexpr_expr_kill_ (ffeexprExpr_ e);
-static void ffeexpr_exprstack_push_ (ffeexprExpr_ e);
-static void ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e);
-static void ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e);
-static void ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e);
-static void ffeexpr_reduce_ (void);
-static ffebld ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op,
-				      ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l,
-				      ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l,
-					    ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l,
-				      ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op,
-				      ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l,
-				      ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l,
-				      ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l,
-				       ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r);
-static ffebld ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op,
-					 ffeexprExpr_ r);
-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,
-					 bool *);
-static ffelexHandler ffeexpr_find_close_paren_ (ffelexToken t,
-						ffelexHandler after);
-static ffelexHandler ffeexpr_nil_finished_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_rhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_end_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_swallow_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_real_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_real_exponent_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_real_exp_sign_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_exponent_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_exp_sign_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_per_exp_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_real_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_num_per_exp_sign_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_number_real_exp_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_num_real_exp_sn_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_binary_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_binary_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_binary_end_per_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_binary_sw_per_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_quote_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_apostrophe_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_apos_char_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_name_rhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_name_apos_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_name_apos_name_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_percent_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_percent_name_ (ffelexToken t);
-static ffelexHandler ffeexpr_nil_substrp_ (ffelexToken t);
-static ffelexHandler ffeexpr_finished_ (ffelexToken t);
-static ffebld ffeexpr_finished_ambig_ (ffelexToken t, ffebld expr);
-static ffelexHandler ffeexpr_token_lhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_rhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_binary_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_end_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_swallow_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_real_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_real_exponent_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_real_exp_sign_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_exponent_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_exp_sign_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_per_exp_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_real_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_num_per_exp_sign_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_number_real_exp_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_num_real_exp_sn_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_binary_period_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_binary_end_per_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_binary_sw_per_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_quote_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_apostrophe_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_apos_char_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_name_lhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_name_arg_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_name_rhs_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_name_apos_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_name_apos_name_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_percent_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_percent_name_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr,
-					       ffelexToken t);
-static ffelexHandler ffeexpr_token_elements_ (ffelexToken ft, ffebld expr,
-					      ffelexToken t);
-static ffelexHandler ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr,
-						 ffelexToken t);
-static ffelexHandler ffeexpr_token_substring_ (ffelexToken ft, ffebld expr,
-					       ffelexToken t);
-static ffelexHandler ffeexpr_token_substring_1_ (ffelexToken ft, ffebld expr,
-						 ffelexToken t);
-static ffelexHandler ffeexpr_token_substrp_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_intrincheck_ (ffelexToken t);
-static ffelexHandler ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr,
-					       ffelexToken t);
-static ffelexHandler ffeexpr_token_anything_ (ffelexToken ft, ffebld expr,
-					      ffelexToken t);
-static void ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
-	    ffelexToken decimal, ffelexToken fraction, ffelexToken exponent,
-		    ffelexToken exponent_sign, ffelexToken exponent_digits);
-static ffesymbol ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin);
-static ffesymbol ffeexpr_sym_impdoitem_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t);
-static ffesymbol ffeexpr_declare_parenthesized_ (ffelexToken t,
-						 bool maybe_intrin,
-					     ffeexprParenType_ *paren_type);
-static ffesymbol ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t);
-
-/* Internal macros. */
-
-#define ffeexpr_paren_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
-#define ffeexpr_sym_lhs_let_(s,t) ffeexpr_sym_rhs_let_(s,t)
-
-/* ffeexpr_collapse_convert -- Collapse convert expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_convert(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_convert (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize sz;
-  ffetargetCharacterSize sz2;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      sz = FFETARGET_charactersizeNONE;
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_integer1_integer2
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_integer1_integer3
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_integer1_integer4
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER1/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_integer1_real1
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer1_real2
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer1_real3
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER1/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_integer1_complex1
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer1_complex2
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer1_complex3
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER1/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_integer1_logical1
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_integer1_logical2
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_integer1_logical3
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_integer1_logical4
-		    (ffebld_cu_ptr_integer1 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER1/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_integer1_character1
-		(ffebld_cu_ptr_integer1 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_integer1_hollerith
-		(ffebld_cu_ptr_integer1 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_integer1_typeless
-		(ffebld_cu_ptr_integer1 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("INTEGER1 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_integer1_val
-	     (ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_integer2_integer1
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_integer2_integer3
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_integer2_integer4
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER2/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_integer2_real1
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer2_real2
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer2_real3
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER2/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_integer2_complex1
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer2_complex2
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer2_complex3
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER2/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_integer2_logical1
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_integer2_logical2
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_integer2_logical3
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_integer2_logical4
-		    (ffebld_cu_ptr_integer2 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER2/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_integer2_character1
-		(ffebld_cu_ptr_integer2 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_integer2_hollerith
-		(ffebld_cu_ptr_integer2 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_integer2_typeless
-		(ffebld_cu_ptr_integer2 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("INTEGER2 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_integer2_val
-	     (ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_integer3_integer1
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_integer3_integer2
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_integer3_integer4
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER3/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_integer3_real1
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer3_real2
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer3_real3
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER3/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_integer3_complex1
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer3_complex2
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer3_complex3
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_integer3_logical1
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_integer3_logical2
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_integer3_logical3
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_integer3_logical4
-		    (ffebld_cu_ptr_integer3 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER3/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_integer3_character1
-		(ffebld_cu_ptr_integer3 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_integer3_hollerith
-		(ffebld_cu_ptr_integer3 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_integer3_typeless
-		(ffebld_cu_ptr_integer3 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("INTEGER3 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_integer3_val
-	     (ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_integer4_integer1
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_integer4_integer2
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_integer4_integer3
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER4/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_integer4_real1
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer4_real2
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer4_real3
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER4/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_integer4_complex1
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_integer4_complex2
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_integer4_complex3
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER3/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_integer4_logical1
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_integer4_logical2
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_integer4_logical3
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_integer4_logical4
-		    (ffebld_cu_ptr_integer4 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("INTEGER4/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_integer4_character1
-		(ffebld_cu_ptr_integer4 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_integer4_hollerith
-		(ffebld_cu_ptr_integer4 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_integer4_typeless
-		(ffebld_cu_ptr_integer4 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("INTEGER4 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_integer4_val
-	     (ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      sz = FFETARGET_charactersizeNONE;
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_logical1_logical2
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_logical1_logical3
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_logical1_logical4
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL1/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_logical1_integer1
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_logical1_integer2
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_logical1_integer3
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_logical1_integer4
-		    (ffebld_cu_ptr_logical1 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL1/INTEGER bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_logical1_character1
-		(ffebld_cu_ptr_logical1 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_logical1_hollerith
-		(ffebld_cu_ptr_logical1 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_logical1_typeless
-		(ffebld_cu_ptr_logical1 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("LOGICAL1 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_logical1_val
-	     (ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_logical2_logical1
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_logical2_logical3
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_logical2_logical4
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL2/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_logical2_integer1
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_logical2_integer2
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_logical2_integer3
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_logical2_integer4
-		    (ffebld_cu_ptr_logical2 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL2/INTEGER bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_logical2_character1
-		(ffebld_cu_ptr_logical2 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_logical2_hollerith
-		(ffebld_cu_ptr_logical2 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_logical2_typeless
-		(ffebld_cu_ptr_logical2 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("LOGICAL2 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_logical2_val
-	     (ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_logical3_logical1
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_logical3_logical2
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error = ffetarget_convert_logical3_logical4
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_logical4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL3/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_logical3_integer1
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_logical3_integer2
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_logical3_integer3
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_logical3_integer4
-		    (ffebld_cu_ptr_logical3 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL3/INTEGER bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_logical3_character1
-		(ffebld_cu_ptr_logical3 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_logical3_hollerith
-		(ffebld_cu_ptr_logical3 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_logical3_typeless
-		(ffebld_cu_ptr_logical3 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("LOGICAL3 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_logical3_val
-	     (ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error = ffetarget_convert_logical4_logical1
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_logical1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error = ffetarget_convert_logical4_logical2
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_logical2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error = ffetarget_convert_logical4_logical3
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_logical3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL4/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_logical4_integer1
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_logical4_integer2
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_logical4_integer3
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_logical4_integer4
-		    (ffebld_cu_ptr_logical4 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("LOGICAL4/INTEGER bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_logical4_character1
-		(ffebld_cu_ptr_logical4 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_logical4_hollerith
-		(ffebld_cu_ptr_logical4 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_logical4_typeless
-		(ffebld_cu_ptr_logical4 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("LOGICAL4 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_logical4_val
-	     (ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      sz = FFETARGET_charactersizeNONE;
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_real1_integer1
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_real1_integer2
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_real1_integer3
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_real1_integer4
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL1/INTEGER bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeREAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_real1_real2
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_real1_real3
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL1/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_real1_complex1
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_real1_complex2
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_real1_complex3
-		    (ffebld_cu_ptr_real1 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL1/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_real1_character1
-		(ffebld_cu_ptr_real1 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_real1_hollerith
-		(ffebld_cu_ptr_real1 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_real1_typeless
-		(ffebld_cu_ptr_real1 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("REAL1 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_real1_val
-	     (ffebld_cu_val_real1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_real2_integer1
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_real2_integer2
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_real2_integer3
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_real2_integer4
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL2/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_real2_real1
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_real2_real3
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL2/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_real2_complex1
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_real2_complex2
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_real2_complex3
-		    (ffebld_cu_ptr_real2 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL2/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_real2_character1
-		(ffebld_cu_ptr_real2 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_real2_hollerith
-		(ffebld_cu_ptr_real2 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_real2_typeless
-		(ffebld_cu_ptr_real2 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("REAL2 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_real2_val
-	     (ffebld_cu_val_real2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_real3_integer1
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_real3_integer2
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_real3_integer3
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_real3_integer4
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL3/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_real3_real1
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_real3_real2
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL3/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_real3_complex1
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_real3_complex2
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_real3_complex3
-		    (ffebld_cu_ptr_real3 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("REAL3/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_real3_character1
-		(ffebld_cu_ptr_real3 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_real3_hollerith
-		(ffebld_cu_ptr_real3 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_real3_typeless
-		(ffebld_cu_ptr_real3 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("REAL3 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_real3_val
-	     (ffebld_cu_val_real3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      sz = FFETARGET_charactersizeNONE;
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_complex1_integer1
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_complex1_integer2
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_complex1_integer3
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_complex1_integer4
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX1/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_complex1_real1
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_complex1_real2
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_complex1_real3
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX1/REAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCOMPLEX:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_complex1_complex2
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_complex1_complex3
-		    (ffebld_cu_ptr_complex1 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX1/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_complex1_character1
-		(ffebld_cu_ptr_complex1 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_complex1_hollerith
-		(ffebld_cu_ptr_complex1 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_complex1_typeless
-		(ffebld_cu_ptr_complex1 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("COMPLEX1 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_complex1_val
-	     (ffebld_cu_val_complex1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_complex2_integer1
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_complex2_integer2
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_complex2_integer3
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_complex2_integer4
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX2/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_complex2_real1
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_complex2_real2
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_complex2_real3
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX2/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_complex2_complex1
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_complex2_complex3
-		    (ffebld_cu_ptr_complex2 (u),
-		     ffebld_constant_complex3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX2/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_complex2_character1
-		(ffebld_cu_ptr_complex2 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_complex2_hollerith
-		(ffebld_cu_ptr_complex2 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_complex2_typeless
-		(ffebld_cu_ptr_complex2 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("COMPLEX2 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_complex2_val
-	     (ffebld_cu_val_complex2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error = ffetarget_convert_complex3_integer1
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_integer1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error = ffetarget_convert_complex3_integer2
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_integer2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error = ffetarget_convert_complex3_integer3
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_integer3 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error = ffetarget_convert_complex3_integer4
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_integer4 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX3/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_complex3_real1
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_real1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_complex3_real2
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_real2 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okREAL3
-		case FFEINFO_kindtypeREAL3:
-		  error = ffetarget_convert_complex3_real3
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_real3 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX3/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_complex3_complex1
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_complex1 (ffebld_conter (l)));
-		  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-		case FFEINFO_kindtypeREAL2:
-		  error = ffetarget_convert_complex3_complex2
-		    (ffebld_cu_ptr_complex3 (u),
-		     ffebld_constant_complex2 (ffebld_conter (l)));
-		  break;
-#endif
-
-		default:
-		  assert ("COMPLEX3/COMPLEX bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      error = ffetarget_convert_complex3_character1
-		(ffebld_cu_ptr_complex3 (u),
-		 ffebld_constant_character1 (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error = ffetarget_convert_complex3_hollerith
-		(ffebld_cu_ptr_complex3 (u),
-		 ffebld_constant_hollerith (ffebld_conter (l)));
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error = ffetarget_convert_complex3_typeless
-		(ffebld_cu_ptr_complex3 (u),
-		 ffebld_constant_typeless (ffebld_conter (l)));
-	      break;
-
-	    default:
-	      assert ("COMPLEX3 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_complex3_val
-	     (ffebld_cu_val_complex3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      if ((sz = ffebld_size (expr)) == FFETARGET_charactersizeNONE)
-	return expr;
-      kt = ffeinfo_kindtype (ffebld_info (expr));
-      switch (kt)
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  switch (ffeinfo_basictype (ffebld_info (l)))
-	    {
-	    case FFEINFO_basictypeCHARACTER:
-	      if ((sz2 = ffebld_size (l)) == FFETARGET_charactersizeNONE)
-		return expr;
-	      assert (kt == ffeinfo_kindtype (ffebld_info (l)));
-	      assert (sz2 == ffetarget_length_character1
-		      (ffebld_constant_character1
-		       (ffebld_conter (l))));
-	      error
-		= ffetarget_convert_character1_character1
-		(ffebld_cu_ptr_character1 (u), sz,
-		 ffebld_constant_character1 (ffebld_conter (l)),
-		 ffebld_constant_pool ());
-	      break;
-
-	    case FFEINFO_basictypeINTEGER:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okINTEGER1
-		case FFEINFO_kindtypeINTEGER1:
-		  error
-		    = ffetarget_convert_character1_integer1
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_integer1 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-		case FFEINFO_kindtypeINTEGER2:
-		  error
-		    = ffetarget_convert_character1_integer2
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_integer2 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-		case FFEINFO_kindtypeINTEGER3:
-		  error
-		    = ffetarget_convert_character1_integer3
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_integer3 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-		case FFEINFO_kindtypeINTEGER4:
-		  error
-		    = ffetarget_convert_character1_integer4
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_integer4 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-		default:
-		  assert ("CHARACTER1/INTEGER bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeLOGICAL:
-	      switch (ffeinfo_kindtype (ffebld_info (l)))
-		{
-#if FFETARGET_okLOGICAL1
-		case FFEINFO_kindtypeLOGICAL1:
-		  error
-		    = ffetarget_convert_character1_logical1
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_logical1 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-		case FFEINFO_kindtypeLOGICAL2:
-		  error
-		    = ffetarget_convert_character1_logical2
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_logical2 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-		case FFEINFO_kindtypeLOGICAL3:
-		  error
-		    = ffetarget_convert_character1_logical3
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_logical3 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-		case FFEINFO_kindtypeLOGICAL4:
-		  error
-		    = ffetarget_convert_character1_logical4
-		      (ffebld_cu_ptr_character1 (u),
-		       sz,
-		       ffebld_constant_logical4 (ffebld_conter (l)),
-		       ffebld_constant_pool ());
-		  break;
-#endif
-
-		default:
-		  assert ("CHARACTER1/LOGICAL bad source kind type" == NULL);
-		  break;
-		}
-	      break;
-
-	    case FFEINFO_basictypeHOLLERITH:
-	      error
-		= ffetarget_convert_character1_hollerith
-		(ffebld_cu_ptr_character1 (u),
-		 sz,
-		 ffebld_constant_hollerith (ffebld_conter (l)),
-		 ffebld_constant_pool ());
-	      break;
-
-	    case FFEINFO_basictypeTYPELESS:
-	      error
-		= ffetarget_convert_character1_typeless
-		(ffebld_cu_ptr_character1 (u),
-		 sz,
-		 ffebld_constant_typeless (ffebld_conter (l)),
-		 ffebld_constant_pool ());
-	      break;
-
-	    default:
-	      assert ("CHARACTER1 bad type" == NULL);
-	    }
-
-	  expr
-	    = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_character1_val
-	     (ffebld_cu_val_character1 (u)),
-	     expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad character kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    sz));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      assert (t != NULL);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_paren -- Collapse paren expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_paren(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_paren (ffebld expr, ffelexToken t UNUSED)
-{
-  ffebld r;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize len;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  r = ffebld_left (expr);
-
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  bt = ffeinfo_basictype (ffebld_info (r));
-  kt = ffeinfo_kindtype (ffebld_info (r));
-  len = ffebld_size (r);
-
-  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
-				      expr);
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    len));
-
-  return expr;
-}
-
-/* ffeexpr_collapse_uplus -- Collapse uplus expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_uplus(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_uplus (ffebld expr, ffelexToken t UNUSED)
-{
-  ffebld r;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize len;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  r = ffebld_left (expr);
-
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  bt = ffeinfo_basictype (ffebld_info (r));
-  kt = ffeinfo_kindtype (ffebld_info (r));
-  len = ffebld_size (r);
-
-  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
-				      expr);
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    len));
-
-  return expr;
-}
-
-/* ffeexpr_collapse_uminus -- Collapse uminus expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_uminus(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_uminus (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  r = ffebld_left (expr);
-
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_uminus_integer1 (ffebld_cu_ptr_integer1 (u),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_uminus_integer2 (ffebld_cu_ptr_integer2 (u),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_uminus_integer3 (ffebld_cu_ptr_integer3 (u),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_uminus_integer4 (ffebld_cu_ptr_integer4 (u),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_uminus_real1 (ffebld_cu_ptr_real1 (u),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
-					   (ffebld_cu_val_real1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_uminus_real2 (ffebld_cu_ptr_real2 (u),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
-					   (ffebld_cu_val_real2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_uminus_real3 (ffebld_cu_ptr_real3 (u),
-				 ffebld_constant_real3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
-					   (ffebld_cu_val_real3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_uminus_complex1 (ffebld_cu_ptr_complex1 (u),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
-					(ffebld_cu_val_complex1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_uminus_complex2 (ffebld_cu_ptr_complex2 (u),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
-					(ffebld_cu_val_complex2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_uminus_complex3 (ffebld_cu_ptr_complex3 (u),
-			      ffebld_constant_complex3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
-					(ffebld_cu_val_complex3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_not -- Collapse not expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_not(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_not (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  r = ffebld_left (expr);
-
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_not_integer1 (ffebld_cu_ptr_integer1 (u),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_not_integer2 (ffebld_cu_ptr_integer2 (u),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_not_integer3 (ffebld_cu_ptr_integer3 (u),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_not_integer4 (ffebld_cu_ptr_integer4 (u),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  error = ffetarget_not_logical1 (ffebld_cu_ptr_logical1 (u),
-			      ffebld_constant_logical1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
-					(ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  error = ffetarget_not_logical2 (ffebld_cu_ptr_logical2 (u),
-			      ffebld_constant_logical2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
-					(ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  error = ffetarget_not_logical3 (ffebld_cu_ptr_logical3 (u),
-			      ffebld_constant_logical3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
-					(ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  error = ffetarget_not_logical4 (ffebld_cu_ptr_logical4 (u),
-			      ffebld_constant_logical4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
-					(ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_add -- Collapse add expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_add(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_add (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_add_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_add_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_add_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_add_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_add_real1 (ffebld_cu_ptr_real1 (u),
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
-					   (ffebld_cu_val_real1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_add_real2 (ffebld_cu_ptr_real2 (u),
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
-					   (ffebld_cu_val_real2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_add_real3 (ffebld_cu_ptr_real3 (u),
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
-					   (ffebld_cu_val_real3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_add_complex1 (ffebld_cu_ptr_complex1 (u),
-			       ffebld_constant_complex1 (ffebld_conter (l)),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
-					(ffebld_cu_val_complex1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_add_complex2 (ffebld_cu_ptr_complex2 (u),
-			       ffebld_constant_complex2 (ffebld_conter (l)),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
-					(ffebld_cu_val_complex2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_add_complex3 (ffebld_cu_ptr_complex3 (u),
-			       ffebld_constant_complex3 (ffebld_conter (l)),
-			      ffebld_constant_complex3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
-					(ffebld_cu_val_complex3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_subtract -- Collapse subtract expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_subtract(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_subtract (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_subtract_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_subtract_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_subtract_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_subtract_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_subtract_real1 (ffebld_cu_ptr_real1 (u),
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
-					   (ffebld_cu_val_real1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_subtract_real2 (ffebld_cu_ptr_real2 (u),
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
-					   (ffebld_cu_val_real2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_subtract_real3 (ffebld_cu_ptr_real3 (u),
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
-					   (ffebld_cu_val_real3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_subtract_complex1 (ffebld_cu_ptr_complex1 (u),
-			       ffebld_constant_complex1 (ffebld_conter (l)),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
-					(ffebld_cu_val_complex1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_subtract_complex2 (ffebld_cu_ptr_complex2 (u),
-			       ffebld_constant_complex2 (ffebld_conter (l)),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
-					(ffebld_cu_val_complex2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_subtract_complex3 (ffebld_cu_ptr_complex3 (u),
-			       ffebld_constant_complex3 (ffebld_conter (l)),
-			      ffebld_constant_complex3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
-					(ffebld_cu_val_complex3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_multiply -- Collapse multiply expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_multiply(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_multiply (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_multiply_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_multiply_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_multiply_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_multiply_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_multiply_real1 (ffebld_cu_ptr_real1 (u),
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
-					   (ffebld_cu_val_real1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_multiply_real2 (ffebld_cu_ptr_real2 (u),
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
-					   (ffebld_cu_val_real2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_multiply_real3 (ffebld_cu_ptr_real3 (u),
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
-					   (ffebld_cu_val_real3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_multiply_complex1 (ffebld_cu_ptr_complex1 (u),
-			       ffebld_constant_complex1 (ffebld_conter (l)),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
-					(ffebld_cu_val_complex1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_multiply_complex2 (ffebld_cu_ptr_complex2 (u),
-			       ffebld_constant_complex2 (ffebld_conter (l)),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
-					(ffebld_cu_val_complex2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_multiply_complex3 (ffebld_cu_ptr_complex3 (u),
-			       ffebld_constant_complex3 (ffebld_conter (l)),
-			      ffebld_constant_complex3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
-					(ffebld_cu_val_complex3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_divide -- Collapse divide expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_divide(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_divide (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_divide_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_divide_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_divide_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_divide_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_divide_real1 (ffebld_cu_ptr_real1 (u),
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real1_val
-					   (ffebld_cu_val_real1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_divide_real2 (ffebld_cu_ptr_real2 (u),
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real2_val
-					   (ffebld_cu_val_real2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_divide_real3 (ffebld_cu_ptr_real3 (u),
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_real3_val
-					   (ffebld_cu_val_real3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_divide_complex1 (ffebld_cu_ptr_complex1 (u),
-			       ffebld_constant_complex1 (ffebld_conter (l)),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex1_val
-					(ffebld_cu_val_complex1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_divide_complex2 (ffebld_cu_ptr_complex2 (u),
-			       ffebld_constant_complex2 (ffebld_conter (l)),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex2_val
-					(ffebld_cu_val_complex2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_divide_complex3 (ffebld_cu_ptr_complex3 (u),
-			       ffebld_constant_complex3 (ffebld_conter (l)),
-			      ffebld_constant_complex3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_complex3_val
-					(ffebld_cu_val_complex3 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_power -- Collapse power expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_power(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_power (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  if ((ffeinfo_basictype (ffebld_info (r)) != FFEINFO_basictypeINTEGER)
-  || (ffeinfo_kindtype (ffebld_info (r)) != FFEINFO_kindtypeINTEGERDEFAULT))
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-	case FFEINFO_kindtypeINTEGERDEFAULT:
-	  error = ffetarget_power_integerdefault_integerdefault
-	    (ffebld_cu_ptr_integerdefault (u),
-	     ffebld_constant_integerdefault (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_integerdefault_val
-	     (ffebld_cu_val_integerdefault (u)), expr);
-	  break;
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-	case FFEINFO_kindtypeREALDEFAULT:
-	  error = ffetarget_power_realdefault_integerdefault
-	    (ffebld_cu_ptr_realdefault (u),
-	     ffebld_constant_realdefault (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_realdefault_val
-	     (ffebld_cu_val_realdefault (u)), expr);
-	  break;
-
-	case FFEINFO_kindtypeREALDOUBLE:
-	  error = ffetarget_power_realdouble_integerdefault
-	    (ffebld_cu_ptr_realdouble (u),
-	     ffebld_constant_realdouble (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_realdouble_val
-	     (ffebld_cu_val_realdouble (u)), expr);
-	  break;
-
-#if FFETARGET_okREALQUAD
-	case FFEINFO_kindtypeREALQUAD:
-	  error = ffetarget_power_realquad_integerdefault
-	    (ffebld_cu_ptr_realquad (u),
-	     ffebld_constant_realquad (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_realquad_val
-	     (ffebld_cu_val_realquad (u)), expr);
-	  break;
-#endif
-	default:
-	  assert ("bad real kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-	case FFEINFO_kindtypeREALDEFAULT:
-	  error = ffetarget_power_complexdefault_integerdefault
-	    (ffebld_cu_ptr_complexdefault (u),
-	     ffebld_constant_complexdefault (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_complexdefault_val
-	     (ffebld_cu_val_complexdefault (u)), expr);
-	  break;
-
-#if FFETARGET_okCOMPLEXDOUBLE
-	case FFEINFO_kindtypeREALDOUBLE:
-	  error = ffetarget_power_complexdouble_integerdefault
-	    (ffebld_cu_ptr_complexdouble (u),
-	     ffebld_constant_complexdouble (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_complexdouble_val
-	     (ffebld_cu_val_complexdouble (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEXQUAD
-	case FFEINFO_kindtypeREALQUAD:
-	  error = ffetarget_power_complexquad_integerdefault
-	    (ffebld_cu_ptr_complexquad (u),
-	     ffebld_constant_complexquad (ffebld_conter (l)),
-	     ffebld_constant_integerdefault (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_complexquad_val
-	     (ffebld_cu_val_complexquad (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad complex kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_concatenate -- Collapse concatenate expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_concatenate(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize len;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_concatenate_character1 (ffebld_cu_ptr_character1 (u),
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			     ffebld_constant_character1 (ffebld_conter (r)),
-				   ffebld_constant_pool (), &len);
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
-				      (ffebld_cu_val_character1 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad character kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeCHARACTER,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    len));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_eq -- Collapse eq expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_eq(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_eq (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  bool val;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_eq_integer1 (&val,
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_eq_integer2 (&val,
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_eq_integer3 (&val,
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_eq_integer4 (&val,
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_eq_real1 (&val,
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_eq_real2 (&val,
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_eq_real3 (&val,
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_eq_complex1 (&val,
-			       ffebld_constant_complex1 (ffebld_conter (l)),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_eq_complex2 (&val,
-			       ffebld_constant_complex2 (ffebld_conter (l)),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_eq_complex3 (&val,
-			       ffebld_constant_complex3 (ffebld_conter (l)),
-			      ffebld_constant_complex3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_eq_character1 (&val,
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			    ffebld_constant_character1 (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;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeLOGICAL,
-		    FFEINFO_kindtypeLOGICALDEFAULT,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_ne -- Collapse ne expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_ne(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_ne (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  bool val;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_ne_integer1 (&val,
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_ne_integer2 (&val,
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_ne_integer3 (&val,
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_ne_integer4 (&val,
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_ne_real1 (&val,
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_ne_real2 (&val,
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_ne_real3 (&val,
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCOMPLEX:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_ne_complex1 (&val,
-			       ffebld_constant_complex1 (ffebld_conter (l)),
-			      ffebld_constant_complex1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_ne_complex2 (&val,
-			       ffebld_constant_complex2 (ffebld_conter (l)),
-			      ffebld_constant_complex2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_ne_complex3 (&val,
-			       ffebld_constant_complex3 (ffebld_conter (l)),
-			      ffebld_constant_complex3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_ne_character1 (&val,
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			    ffebld_constant_character1 (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;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeLOGICAL,
-		    FFEINFO_kindtypeLOGICALDEFAULT,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_ge -- Collapse ge expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_ge(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_ge (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  bool val;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_ge_integer1 (&val,
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_ge_integer2 (&val,
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_ge_integer3 (&val,
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_ge_integer4 (&val,
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_ge_real1 (&val,
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_ge_real2 (&val,
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_ge_real3 (&val,
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_ge_character1 (&val,
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			    ffebld_constant_character1 (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;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeLOGICAL,
-		    FFEINFO_kindtypeLOGICALDEFAULT,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_gt -- Collapse gt expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_gt(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_gt (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  bool val;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_gt_integer1 (&val,
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_gt_integer2 (&val,
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_gt_integer3 (&val,
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_gt_integer4 (&val,
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_gt_real1 (&val,
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_gt_real2 (&val,
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_gt_real3 (&val,
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_gt_character1 (&val,
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			    ffebld_constant_character1 (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;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeLOGICAL,
-		    FFEINFO_kindtypeLOGICALDEFAULT,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_le -- Collapse le expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_le(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_le (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  bool val;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_le_integer1 (&val,
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_le_integer2 (&val,
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_le_integer3 (&val,
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_le_integer4 (&val,
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_le_real1 (&val,
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_le_real2 (&val,
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_le_real3 (&val,
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_le_character1 (&val,
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			    ffebld_constant_character1 (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;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeLOGICAL,
-		    FFEINFO_kindtypeLOGICALDEFAULT,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_lt -- Collapse lt expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_lt(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_lt (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  bool val;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (ffeinfo_basictype (ffebld_info (ffebld_left (expr))))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_lt_integer1 (&val,
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_lt_integer2 (&val,
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_lt_integer3 (&val,
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_lt_integer4 (&val,
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeREAL:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okREAL1
-	case FFEINFO_kindtypeREAL1:
-	  error = ffetarget_lt_real1 (&val,
-				  ffebld_constant_real1 (ffebld_conter (l)),
-				 ffebld_constant_real1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL2
-	case FFEINFO_kindtypeREAL2:
-	  error = ffetarget_lt_real2 (&val,
-				  ffebld_constant_real2 (ffebld_conter (l)),
-				 ffebld_constant_real2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig
-	    (ffebld_constant_new_logicaldefault (val), expr);
-	  break;
-#endif
-
-#if FFETARGET_okREAL3
-	case FFEINFO_kindtypeREAL3:
-	  error = ffetarget_lt_real3 (&val,
-				  ffebld_constant_real3 (ffebld_conter (l)),
-				 ffebld_constant_real3 (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;
-	}
-      break;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (ffeinfo_kindtype (ffebld_info (ffebld_left (expr))))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_lt_character1 (&val,
-			     ffebld_constant_character1 (ffebld_conter (l)),
-			    ffebld_constant_character1 (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;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeLOGICAL,
-		    FFEINFO_kindtypeLOGICALDEFAULT,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_and -- Collapse and expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_and(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_and (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_and_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_and_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_and_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_and_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  error = ffetarget_and_logical1 (ffebld_cu_ptr_logical1 (u),
-			       ffebld_constant_logical1 (ffebld_conter (l)),
-			      ffebld_constant_logical1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
-					(ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  error = ffetarget_and_logical2 (ffebld_cu_ptr_logical2 (u),
-			       ffebld_constant_logical2 (ffebld_conter (l)),
-			      ffebld_constant_logical2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
-					(ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  error = ffetarget_and_logical3 (ffebld_cu_ptr_logical3 (u),
-			       ffebld_constant_logical3 (ffebld_conter (l)),
-			      ffebld_constant_logical3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
-					(ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  error = ffetarget_and_logical4 (ffebld_cu_ptr_logical4 (u),
-			       ffebld_constant_logical4 (ffebld_conter (l)),
-			      ffebld_constant_logical4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
-					(ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_or -- Collapse or expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_or(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_or (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_or_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_or_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_or_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_or_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  error = ffetarget_or_logical1 (ffebld_cu_ptr_logical1 (u),
-			       ffebld_constant_logical1 (ffebld_conter (l)),
-			      ffebld_constant_logical1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
-					(ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  error = ffetarget_or_logical2 (ffebld_cu_ptr_logical2 (u),
-			       ffebld_constant_logical2 (ffebld_conter (l)),
-			      ffebld_constant_logical2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
-					(ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  error = ffetarget_or_logical3 (ffebld_cu_ptr_logical3 (u),
-			       ffebld_constant_logical3 (ffebld_conter (l)),
-			      ffebld_constant_logical3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
-					(ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  error = ffetarget_or_logical4 (ffebld_cu_ptr_logical4 (u),
-			       ffebld_constant_logical4 (ffebld_conter (l)),
-			      ffebld_constant_logical4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
-					(ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_xor -- Collapse xor expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_xor(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_xor (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_xor_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_xor_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_xor_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_xor_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  error = ffetarget_xor_logical1 (ffebld_cu_ptr_logical1 (u),
-			       ffebld_constant_logical1 (ffebld_conter (l)),
-			      ffebld_constant_logical1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
-					(ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  error = ffetarget_xor_logical2 (ffebld_cu_ptr_logical2 (u),
-			       ffebld_constant_logical2 (ffebld_conter (l)),
-			      ffebld_constant_logical2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
-					(ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  error = ffetarget_xor_logical3 (ffebld_cu_ptr_logical3 (u),
-			       ffebld_constant_logical3 (ffebld_conter (l)),
-			      ffebld_constant_logical3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
-					(ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  error = ffetarget_xor_logical4 (ffebld_cu_ptr_logical4 (u),
-			       ffebld_constant_logical4 (ffebld_conter (l)),
-			      ffebld_constant_logical4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
-					(ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_eqv -- Collapse eqv expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_eqv(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_eqv (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_eqv_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_eqv_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_eqv_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_eqv_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  error = ffetarget_eqv_logical1 (ffebld_cu_ptr_logical1 (u),
-			       ffebld_constant_logical1 (ffebld_conter (l)),
-			      ffebld_constant_logical1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
-					(ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  error = ffetarget_eqv_logical2 (ffebld_cu_ptr_logical2 (u),
-			       ffebld_constant_logical2 (ffebld_conter (l)),
-			      ffebld_constant_logical2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
-					(ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  error = ffetarget_eqv_logical3 (ffebld_cu_ptr_logical3 (u),
-			       ffebld_constant_logical3 (ffebld_conter (l)),
-			      ffebld_constant_logical3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
-					(ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  error = ffetarget_eqv_logical4 (ffebld_cu_ptr_logical4 (u),
-			       ffebld_constant_logical4 (ffebld_conter (l)),
-			      ffebld_constant_logical4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
-					(ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_neqv -- Collapse neqv expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_neqv(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_neqv (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebldConstantUnion u;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-  if (ffebld_op (r) != FFEBLD_opCONTER)
-    return expr;
-
-  switch (bt = ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeINTEGER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  error = ffetarget_neqv_integer1 (ffebld_cu_ptr_integer1 (u),
-			       ffebld_constant_integer1 (ffebld_conter (l)),
-			      ffebld_constant_integer1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer1_val
-					(ffebld_cu_val_integer1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  error = ffetarget_neqv_integer2 (ffebld_cu_ptr_integer2 (u),
-			       ffebld_constant_integer2 (ffebld_conter (l)),
-			      ffebld_constant_integer2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer2_val
-					(ffebld_cu_val_integer2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  error = ffetarget_neqv_integer3 (ffebld_cu_ptr_integer3 (u),
-			       ffebld_constant_integer3 (ffebld_conter (l)),
-			      ffebld_constant_integer3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer3_val
-					(ffebld_cu_val_integer3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER4
-	case FFEINFO_kindtypeINTEGER4:
-	  error = ffetarget_neqv_integer4 (ffebld_cu_ptr_integer4 (u),
-			       ffebld_constant_integer4 (ffebld_conter (l)),
-			      ffebld_constant_integer4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_integer4_val
-					(ffebld_cu_val_integer4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad integer kind type" == NULL);
-	  break;
-	}
-      break;
-
-    case FFEINFO_basictypeLOGICAL:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okLOGICAL1
-	case FFEINFO_kindtypeLOGICAL1:
-	  error = ffetarget_neqv_logical1 (ffebld_cu_ptr_logical1 (u),
-			       ffebld_constant_logical1 (ffebld_conter (l)),
-			      ffebld_constant_logical1 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical1_val
-					(ffebld_cu_val_logical1 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL2
-	case FFEINFO_kindtypeLOGICAL2:
-	  error = ffetarget_neqv_logical2 (ffebld_cu_ptr_logical2 (u),
-			       ffebld_constant_logical2 (ffebld_conter (l)),
-			      ffebld_constant_logical2 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical2_val
-					(ffebld_cu_val_logical2 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL3
-	case FFEINFO_kindtypeLOGICAL3:
-	  error = ffetarget_neqv_logical3 (ffebld_cu_ptr_logical3 (u),
-			       ffebld_constant_logical3 (ffebld_conter (l)),
-			      ffebld_constant_logical3 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical3_val
-					(ffebld_cu_val_logical3 (u)), expr);
-	  break;
-#endif
-
-#if FFETARGET_okLOGICAL4
-	case FFEINFO_kindtypeLOGICAL4:
-	  error = ffetarget_neqv_logical4 (ffebld_cu_ptr_logical4 (u),
-			       ffebld_constant_logical4 (ffebld_conter (l)),
-			      ffebld_constant_logical4 (ffebld_conter (r)));
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_logical4_val
-					(ffebld_cu_val_logical4 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad logical kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    FFETARGET_charactersizeNONE));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_collapse_symter -- Collapse symter expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_symter(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_symter (ffebld expr, ffelexToken t UNUSED)
-{
-  ffebld r;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize len;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  if ((r = ffesymbol_init (ffebld_symter (expr))) == NULL)
-    return expr;		/* A PARAMETER lhs in progress. */
-
-  switch (ffebld_op (r))
-    {
-    case FFEBLD_opCONTER:
-      break;
-
-    case FFEBLD_opANY:
-      return r;
-
-    default:
-      return expr;
-    }
-
-  bt = ffeinfo_basictype (ffebld_info (r));
-  kt = ffeinfo_kindtype (ffebld_info (r));
-  len = ffebld_size (r);
-
-  expr = ffebld_new_conter_with_orig (ffebld_constant_copy (ffebld_conter (r)),
-				      expr);
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (bt,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    len));
-
-  return expr;
-}
-
-/* ffeexpr_collapse_funcref -- Collapse funcref expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_funcref(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_funcref (ffebld expr, ffelexToken t UNUSED)
-{
-  return expr;			/* ~~someday go ahead and collapse these,
-				   though not required */
-}
-
-/* ffeexpr_collapse_arrayref -- Collapse arrayref expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_arrayref(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t UNUSED)
-{
-  return expr;
-}
-
-/* ffeexpr_collapse_substr -- Collapse substr expr
-
-   ffebld expr;
-   ffelexToken token;
-   expr = ffeexpr_collapse_substr(expr,token);
-
-   If the result of the expr is a constant, replaces the expr with the
-   computed constant.  */
-
-ffebld
-ffeexpr_collapse_substr (ffebld expr, ffelexToken t)
-{
-  ffebad error = FFEBAD;
-  ffebld l;
-  ffebld r;
-  ffebld start;
-  ffebld stop;
-  ffebldConstantUnion u;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize len;
-  ffetargetIntegerDefault first;
-  ffetargetIntegerDefault last;
-
-  if (ffeinfo_where (ffebld_info (expr)) != FFEINFO_whereCONSTANT)
-    return expr;
-
-  l = ffebld_left (expr);
-  r = ffebld_right (expr);	/* opITEM. */
-
-  if (ffebld_op (l) != FFEBLD_opCONTER)
-    return expr;
-
-  kt = ffeinfo_kindtype (ffebld_info (l));
-  len = ffebld_size (l);
-
-  start = ffebld_head (r);
-  stop = ffebld_head (ffebld_trail (r));
-  if (start == NULL)
-    first = 1;
-  else
-    {
-      if ((ffebld_op (start) != FFEBLD_opCONTER)
-	  || (ffeinfo_basictype (ffebld_info (start)) != FFEINFO_basictypeINTEGER)
-	  || (ffeinfo_kindtype (ffebld_info (start))
-	      != FFEINFO_kindtypeINTEGERDEFAULT))
-	return expr;
-      first = ffebld_constant_integerdefault (ffebld_conter (start));
-    }
-  if (stop == NULL)
-    last = len;
-  else
-    {
-      if ((ffebld_op (stop) != FFEBLD_opCONTER)
-      || (ffeinfo_basictype (ffebld_info (stop)) != FFEINFO_basictypeINTEGER)
-	  || (ffeinfo_kindtype (ffebld_info (stop))
-	      != FFEINFO_kindtypeINTEGERDEFAULT))
-	return expr;
-      last = ffebld_constant_integerdefault (ffebld_conter (stop));
-    }
-
-  /* Handle problems that should have already been diagnosed, but
-     left in the expression tree.  */
-
-  if (first <= 0)
-    first = 1;
-  if (last < first)
-    last = first + len - 1;
-
-  if ((first == 1) && (last == len))
-    {				/* Same as original. */
-      expr = ffebld_new_conter_with_orig (ffebld_constant_copy
-					  (ffebld_conter (l)), expr);
-      ffebld_set_info (expr, ffeinfo_new
-		       (FFEINFO_basictypeCHARACTER,
-			kt,
-			0,
-			FFEINFO_kindENTITY,
-			FFEINFO_whereCONSTANT,
-			len));
-
-      return expr;
-    }
-
-  switch (ffeinfo_basictype (ffebld_info (expr)))
-    {
-    case FFEINFO_basictypeANY:
-      return expr;
-
-    case FFEINFO_basictypeCHARACTER:
-      switch (kt = ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okCHARACTER1
-	case FFEINFO_kindtypeCHARACTER1:
-	  error = ffetarget_substr_character1 (ffebld_cu_ptr_character1 (u),
-		ffebld_constant_character1 (ffebld_conter (l)), first, last,
-				   ffebld_constant_pool (), &len);
-	  expr = ffebld_new_conter_with_orig (ffebld_constant_new_character1_val
-				      (ffebld_cu_val_character1 (u)), expr);
-	  break;
-#endif
-
-	default:
-	  assert ("bad character kind type" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad type" == NULL);
-      return expr;
-    }
-
-  ffebld_set_info (expr, ffeinfo_new
-		   (FFEINFO_basictypeCHARACTER,
-		    kt,
-		    0,
-		    FFEINFO_kindENTITY,
-		    FFEINFO_whereCONSTANT,
-		    len));
-
-  if ((error != FFEBAD)
-      && ffebad_start (error))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  return expr;
-}
-
-/* ffeexpr_convert -- Convert source expression to given type
-
-   ffebld source;
-   ffelexToken source_token;
-   ffelexToken dest_token;  // Any appropriate token for "destination".
-   ffeinfoBasictype bt;
-   ffeinfoKindtype kt;
-   ffetargetCharactersize sz;
-   ffeexprContext context;  // Mainly LET or DATA.
-   source = ffeexpr_convert(source,source_token,dest_token,bt,kt,sz,context);
-
-   If the expression conforms, returns the source expression.  Otherwise
-   returns source wrapped in a convert node doing the conversion, or
-   ANY wrapped in convert if there is a conversion error (and issues an
-   error message).  Be sensitive to the context for certain aspects of
-   the conversion.  */
-
-ffebld
-ffeexpr_convert (ffebld source, ffelexToken source_token, ffelexToken dest_token,
-		 ffeinfoBasictype bt, ffeinfoKindtype kt, ffeinfoRank rk,
-		 ffetargetCharacterSize sz, ffeexprContext context)
-{
-  bool bad;
-  ffeinfo info;
-  ffeinfoWhere wh;
-
-  info = ffebld_info (source);
-  if ((bt != ffeinfo_basictype (info))
-      || (kt != ffeinfo_kindtype (info))
-      || (rk != 0)		/* Can't convert from or to arrays yet. */
-      || (ffeinfo_rank (info) != 0)
-      || (sz != ffebld_size_known (source)))
-#if 0	/* Nobody seems to need this spurious CONVERT node. */
-      || ((context != FFEEXPR_contextLET)
-	  && (bt == FFEINFO_basictypeCHARACTER)
-	  && (sz == FFETARGET_charactersizeNONE)))
-#endif
-    {
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  switch (bt)
-	    {
-	    case FFEINFO_basictypeLOGICAL:
-	      bad = FALSE;
-	      break;
-
-	    case FFEINFO_basictypeINTEGER:
-	      bad = !ffe_is_ugly_logint ();
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      bad = ffe_is_pedantic ()
-		|| !(ffe_is_ugly_init ()
-		     && (context == FFEEXPR_contextDATA));
-	      break;
-
-	    default:
-	      bad = TRUE;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_basictypeINTEGER:
-	  switch (bt)
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	    case FFEINFO_basictypeREAL:
-	    case FFEINFO_basictypeCOMPLEX:
-	      bad = FALSE;
-	      break;
-
-	    case FFEINFO_basictypeLOGICAL:
-	      bad = !ffe_is_ugly_logint ();
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      bad = ffe_is_pedantic ()
-		|| !(ffe_is_ugly_init ()
-		     && (context == FFEEXPR_contextDATA));
-	      break;
-
-	    default:
-	      bad = TRUE;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  switch (bt)
-	    {
-	    case FFEINFO_basictypeINTEGER:
-	    case FFEINFO_basictypeREAL:
-	    case FFEINFO_basictypeCOMPLEX:
-	      bad = FALSE;
-	      break;
-
-	    case FFEINFO_basictypeCHARACTER:
-	      bad = TRUE;
-	      break;
-
-	    default:
-	      bad = TRUE;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_basictypeCHARACTER:
-	  bad = (bt != FFEINFO_basictypeCHARACTER)
-	    && (ffe_is_pedantic ()
-		|| (bt != FFEINFO_basictypeINTEGER)
-		|| !(ffe_is_ugly_init ()
-		     && (context == FFEEXPR_contextDATA)));
-	  break;
-
-	case FFEINFO_basictypeTYPELESS:
-	case FFEINFO_basictypeHOLLERITH:
-	  bad = ffe_is_pedantic ()
-	    || !(ffe_is_ugly_init ()
-		 && ((context == FFEEXPR_contextDATA)
-		     || (context == FFEEXPR_contextLET)));
-	  break;
-
-	default:
-	  bad = TRUE;
-	  break;
-	}
-
-      if (!bad && ((rk != 0) || (ffeinfo_rank (info) != 0)))
-	bad = TRUE;
-
-      if (bad && (bt != FFEINFO_basictypeANY) && (kt != FFEINFO_kindtypeANY)
-	  && (ffeinfo_basictype (info) != FFEINFO_basictypeANY)
-	  && (ffeinfo_kindtype (info) != FFEINFO_kindtypeANY)
-	  && (ffeinfo_where (info) != FFEINFO_whereANY))
-	{
-	  if (ffebad_start (FFEBAD_BAD_TYPES))
-	    {
-	      if (dest_token == NULL)
-		ffebad_here (0, ffewhere_line_unknown (),
-			     ffewhere_column_unknown ());
-	      else
-		ffebad_here (0, ffelex_token_where_line (dest_token),
-			     ffelex_token_where_column (dest_token));
-	      assert (source_token != NULL);
-	      ffebad_here (1, ffelex_token_where_line (source_token),
-			   ffelex_token_where_column (source_token));
-	      ffebad_finish ();
-	    }
-
-	  source = ffebld_new_any ();
-	  ffebld_set_info (source, ffeinfo_new_any ());
-	}
-      else
-	{
-	  switch (ffeinfo_where (info))
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      wh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      wh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      wh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  source = ffebld_new_convert (source);
-	  ffebld_set_info (source, ffeinfo_new
-			   (bt,
-			    kt,
-			    0,
-			    FFEINFO_kindENTITY,
-			    wh,
-			    sz));
-	  source = ffeexpr_collapse_convert (source, source_token);
-	}
-    }
-
-  return source;
-}
-
-/* ffeexpr_convert_expr -- Convert source expr to conform to dest expr
-
-   ffebld source;
-   ffebld dest;
-   ffelexToken source_token;
-   ffelexToken dest_token;
-   ffeexprContext context;
-   source = ffeexpr_convert_expr(source,source_token,dest,dest_token,context);
-
-   If the expressions conform, returns the source expression.  Otherwise
-   returns source wrapped in a convert node doing the conversion, or
-   ANY wrapped in convert if there is a conversion error (and issues an
-   error message).  Be sensitive to the context, such as LET or DATA.  */
-
-ffebld
-ffeexpr_convert_expr (ffebld source, ffelexToken source_token, ffebld dest,
-		      ffelexToken dest_token, ffeexprContext context)
-{
-  ffeinfo info;
-
-  info = ffebld_info (dest);
-  return ffeexpr_convert (source, source_token, dest_token,
-			  ffeinfo_basictype (info),
-			  ffeinfo_kindtype (info),
-			  ffeinfo_rank (info),
-			  ffebld_size_known (dest),
-			  context);
-}
-
-/* ffeexpr_convert_to_sym -- Convert source expression to conform to symbol
-
-   ffebld source;
-   ffesymbol dest;
-   ffelexToken source_token;
-   ffelexToken dest_token;
-   source = ffeexpr_convert_to_sym(source,source_token,dest,dest_token);
-
-   If the expressions conform, returns the source expression.  Otherwise
-   returns source wrapped in a convert node doing the conversion, or
-   ANY wrapped in convert if there is a conversion error (and issues an
-   error message).  */
-
-ffebld
-ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
-			ffesymbol dest, ffelexToken dest_token)
-{
-  return ffeexpr_convert (source, source_token, dest_token, ffesymbol_basictype (dest),
-    ffesymbol_kindtype (dest), ffesymbol_rank (dest), ffesymbol_size (dest),
-			  FFEEXPR_contextLET);
-}
-
-/* Initializes the module.  */
-
-void
-ffeexpr_init_2 (void)
-{
-  ffeexpr_stack_ = NULL;
-  ffeexpr_level_ = 0;
-}
-
-/* ffeexpr_lhs -- Begin processing left-hand-side-context expression
-
-   Prepares cluster for delivery of lexer tokens representing an expression
-   in a left-hand-side context (A in A=B, for example).	 ffebld is used
-   to build expressions in the given pool.  The appropriate lexer-token
-   handling routine within ffeexpr is returned.	 When the end of the
-   expression is detected, mycallbackroutine is called with the resulting
-   single ffebld object specifying the entire expression and the first
-   lexer token that is not considered part of the expression.  This caller-
-   supplied routine itself returns a lexer-token handling routine.  Thus,
-   if necessary, ffeexpr can return several tokens as end-of-expression
-   tokens if it needs to scan forward more than one in any instance.  */
-
-ffelexHandler
-ffeexpr_lhs (mallocPool pool, ffeexprContext context, ffeexprCallback callback)
-{
-  ffeexprStack_ s;
-
-  ffebld_pool_push (pool);
-  s = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR stack", sizeof (*s));
-  s->previous = ffeexpr_stack_;
-  s->pool = pool;
-  s->context = context;
-  s->callback = callback;
-  s->first_token = NULL;
-  s->exprstack = NULL;
-  s->is_rhs = FALSE;
-  ffeexpr_stack_ = s;
-  return (ffelexHandler) ffeexpr_token_first_lhs_;
-}
-
-/* ffeexpr_rhs -- Begin processing right-hand-side-context expression
-
-   return ffeexpr_rhs(malloc_pool_image(),mycallbackroutine);  // to lexer.
-
-   Prepares cluster for delivery of lexer tokens representing an expression
-   in a right-hand-side context (B in A=B, for example).  ffebld is used
-   to build expressions in the given pool.  The appropriate lexer-token
-   handling routine within ffeexpr is returned.	 When the end of the
-   expression is detected, mycallbackroutine is called with the resulting
-   single ffebld object specifying the entire expression and the first
-   lexer token that is not considered part of the expression.  This caller-
-   supplied routine itself returns a lexer-token handling routine.  Thus,
-   if necessary, ffeexpr can return several tokens as end-of-expression
-   tokens if it needs to scan forward more than one in any instance.  */
-
-ffelexHandler
-ffeexpr_rhs (mallocPool pool, ffeexprContext context, ffeexprCallback callback)
-{
-  ffeexprStack_ s;
-
-  ffebld_pool_push (pool);
-  s = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR stack", sizeof (*s));
-  s->previous = ffeexpr_stack_;
-  s->pool = pool;
-  s->context = context;
-  s->callback = callback;
-  s->first_token = NULL;
-  s->exprstack = NULL;
-  s->is_rhs = TRUE;
-  ffeexpr_stack_ = s;
-  return (ffelexHandler) ffeexpr_token_first_rhs_;
-}
-
-/* ffeexpr_cb_close_paren_ -- OPEN_PAREN expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Makes sure the end token is close-paren and swallows it, else issues
-   an error message and doesn't swallow the token (passing it along instead).
-   In either case wraps up subexpression construction by enclosing the
-   ffebld expression in a paren.  */
-
-static ffelexHandler
-ffeexpr_cb_close_paren_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
-    {
-      /* Oops, naughty user didn't specify the close paren! */
-
-      if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		       ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	  ffebad_finish ();
-	}
-
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->u.operand = ffebld_new_any ();
-      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-      ffeexpr_exprstack_push_operand_ (e);
-
-      return
-	(ffelexHandler) ffeexpr_find_close_paren_ (t,
-						   (ffelexHandler)
-						   ffeexpr_token_binary_);
-    }
-
-  if (expr->op == FFEBLD_opIMPDO)
-    {
-      if (ffest_ffebad_start (FFEBAD_IMPDO_PAREN))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		       ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      expr = ffebld_new_paren (expr);
-      ffebld_set_info (expr, ffeinfo_use (ffebld_info (ffebld_left (expr))));
-    }
-
-  /* Now push the (parenthesized) expression as an operand onto the
-     expression stack. */
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->u.operand = expr;
-  e->u.operand = ffeexpr_collapse_paren (e->u.operand, ft);
-  e->token = ffeexpr_stack_->tokens[0];
-  ffeexpr_exprstack_push_operand_ (e);
-
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_cb_close_paren_ambig_ -- OPEN_PAREN expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   We get here in the READ/BACKEND/ENDFILE/REWIND case "READ(expr)"
-   with the next token in t.  If the next token is possibly a binary
-   operator, continue processing the outer expression.	If the next
-   token is COMMA, then the expression is a unit specifier, and
-   parentheses should not be added to it because it surrounds the
-   I/O control list that starts with the unit specifier (and continues
-   on from here -- we haven't seen the CLOSE_PAREN that matches the
-   OPEN_PAREN, it is up to the callback function to expect to see it
-   at some point).  In this case, we notify the callback function that
-   the COMMA is inside, not outside, the parens by wrapping the expression
-   in an opITEM (with a NULL trail) -- the callback function presumably
-   unwraps it after seeing this kludgey indicator.
-
-   If the next token is CLOSE_PAREN, then we go to the _1_ state to
-   decide what to do with the token after that.
-
-   15-Feb-91  JCB  1.1
-      Use an extra state for the CLOSE_PAREN case to make READ &co really
-      work right.  */
-
-static ffelexHandler
-ffeexpr_cb_close_paren_ambig_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    {				/* Need to see the next token before we
-				   decide anything. */
-      ffeexpr_stack_->expr = expr;
-      ffeexpr_tokens_[0] = ffelex_token_use (ft);
-      ffeexpr_tokens_[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_cb_close_paren_ambig_1_;
-    }
-
-  expr = ffeexpr_finished_ambig_ (ft, expr);
-
-  /* Let the callback function handle the case where t isn't COMMA. */
-
-  /* Here is a kludge whereby we tell the callback function the OPEN_PAREN
-     that preceded the expression starts a list of expressions, and the expr
-     hasn't been wrapped in a corresponding (and possibly collapsed) opPAREN
-     node.  The callback function should extract the real expr from the head
-     of this opITEM node after testing it. */
-
-  expr = ffebld_new_item (expr, NULL);
-
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ffelex_token_kill (ffeexpr_stack_->first_token);
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  return (ffelexHandler) (*callback) (ft, expr, t);
-}
-
-/* ffeexpr_cb_close_paren_ambig_1_ -- OPEN_PAREN expr CLOSE_PAREN
-
-   See ffeexpr_cb_close_paren_ambig_.
-
-   We get here in the READ/BACKEND/ENDFILE/REWIND case "READ(expr)"
-   with the next token in t.  If the next token is possibly a binary
-   operator, continue processing the outer expression.	If the next
-   token is COMMA, the expression is a parenthesized format specifier.
-   If the next token is not EOS or SEMICOLON, then because it is not a
-   binary operator (it is NAME, OPEN_PAREN, &c), the expression is
-   a unit specifier, and parentheses should not be added to it because
-   they surround the I/O control list that consists of only the unit
-   specifier.  If the next token is EOS or SEMICOLON, the statement
-   must be disambiguated by looking at the type of the expression -- a
-   character expression is a parenthesized format specifier, while a
-   non-character expression is a unit specifier.
-
-   Another issue is how to do the callback so the recipient of the
-   next token knows how to handle it if it is a COMMA.	In all other
-   cases, disambiguation is straightforward: the same approach as the
-   above is used.
-
-   EXTENSION: in COMMA case, if not pedantic, use same disambiguation
-   as for EOS/SEMICOLON case; f2c allows "READ (cilist) [[,]iolist]"
-   and apparently other compilers do, as well, and some code out there
-   uses this "feature".
-
-   19-Feb-91  JCB  1.1
-      Extend to allow COMMA as nondisambiguating by itself.  Remember
-      to not try and check info field for opSTAR, since that expr doesn't
-      have a valid info field.	*/
-
-static ffelexHandler
-ffeexpr_cb_close_paren_ambig_1_ (ffelexToken t)
-{
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken orig_ft = ffeexpr_tokens_[0];	/* In case callback clobbers
-						   these. */
-  ffelexToken orig_t = ffeexpr_tokens_[1];
-  ffebld expr = ffeexpr_stack_->expr;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:	/* Subexpr is parenthesized format specifier. */
-      if (ffe_is_pedantic ())
-	goto pedantic_comma;	/* :::::::::::::::::::: */
-      /* Fall through. */
-    case FFELEX_typeEOS:	/* Ambiguous; use type of expr to
-				   disambiguate. */
-    case FFELEX_typeSEMICOLON:
-      if ((expr == NULL) || (ffebld_op (expr) == FFEBLD_opANY)
-	  || (ffebld_op (expr) == FFEBLD_opSTAR)
-	  || (ffeinfo_basictype (ffebld_info (expr))
-	      != FFEINFO_basictypeCHARACTER))
-	break;			/* Not a valid CHARACTER entity, can't be a
-				   format spec. */
-      /* Fall through. */
-    default:			/* Binary op (we assume; error otherwise);
-				   format specifier. */
-
-    pedantic_comma:		/* :::::::::::::::::::: */
-
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILENUMAMBIG:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFEEXPR_contextFILEUNITAMBIG:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	default:
-	  assert ("bad context" == NULL);
-	  break;
-	}
-
-      ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
-      next = (ffelexHandler) ffeexpr_cb_close_paren_ (orig_ft, expr, orig_t);
-      ffelex_token_kill (orig_ft);
-      ffelex_token_kill (orig_t);
-      return (ffelexHandler) (*next) (t);
-
-    case FFELEX_typeOPEN_PAREN:/* Non-binary op; beginning of I/O list. */
-    case FFELEX_typeNAME:
-      break;
-    }
-
-  expr = ffeexpr_finished_ambig_ (orig_ft, expr);
-
-  /* Here is a kludge whereby we tell the callback function the OPEN_PAREN
-     that preceded the expression starts a list of expressions, and the expr
-     hasn't been wrapped in a corresponding (and possibly collapsed) opPAREN
-     node.  The callback function should extract the real expr from the head
-     of this opITEM node after testing it. */
-
-  expr = ffebld_new_item (expr, NULL);
-
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ffelex_token_kill (ffeexpr_stack_->first_token);
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  next = (ffelexHandler) (*callback) (orig_ft, expr, orig_t);
-  ffelex_token_kill (orig_ft);
-  ffelex_token_kill (orig_t);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffeexpr_cb_close_paren_c_ -- OPEN_PAREN expr (possible complex)
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Makes sure the end token is close-paren and swallows it, or a comma
-   and handles complex/implied-do possibilities, else issues
-   an error message and doesn't swallow the token (passing it along instead).  */
-
-static ffelexHandler
-ffeexpr_cb_close_paren_c_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  /* First check to see if this is a possible complex entity.  It is if the
-     token is a comma. */
-
-  if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-    {
-      ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
-      ffeexpr_stack_->expr = expr;
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-				FFEEXPR_contextPAREN_, ffeexpr_cb_comma_c_);
-    }
-
-  return (ffelexHandler) ffeexpr_cb_close_paren_ (ft, expr, t);
-}
-
-/* ffeexpr_cb_comma_c_ -- OPEN_PAREN expr COMMA expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   If this token is not a comma, we have a complex constant (or an attempt
-   at one), so handle it accordingly, displaying error messages if the token
-   is not a close-paren.  */
-
-static ffelexHandler
-ffeexpr_cb_comma_c_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffeinfoBasictype lty = (ffeexpr_stack_->expr == NULL)
-    ? FFEINFO_basictypeNONE : ffeinfo_basictype (ffebld_info (ffeexpr_stack_->expr));
-  ffeinfoBasictype rty = (expr == NULL)
-    ? FFEINFO_basictypeNONE : ffeinfo_basictype (ffebld_info (expr));
-  ffeinfoKindtype lkt;
-  ffeinfoKindtype rkt;
-  ffeinfoKindtype nkt;
-  bool ok = TRUE;
-  ffebld orig;
-
-  if ((ffeexpr_stack_->expr == NULL)
-      || (ffebld_op (ffeexpr_stack_->expr) != FFEBLD_opCONTER)
-      || (((orig = ffebld_conter_orig (ffeexpr_stack_->expr)) != NULL)
-	  && (((ffebld_op (orig) != FFEBLD_opUMINUS)
-	       && (ffebld_op (orig) != FFEBLD_opUPLUS))
-	      || (ffebld_conter_orig (ffebld_left (orig)) != NULL)))
-      || ((lty != FFEINFO_basictypeINTEGER)
-	  && (lty != FFEINFO_basictypeREAL)))
-    {
-      if ((lty != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_INVALID_COMPLEX_PART))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
-	  ffebad_string ("Real");
-	  ffebad_finish ();
-	}
-      ok = FALSE;
-    }
-  if ((expr == NULL)
-      || (ffebld_op (expr) != FFEBLD_opCONTER)
-      || (((orig = ffebld_conter_orig (expr)) != NULL)
-	  && (((ffebld_op (orig) != FFEBLD_opUMINUS)
-	       && (ffebld_op (orig) != FFEBLD_opUPLUS))
-	      || (ffebld_conter_orig (ffebld_left (orig)) != NULL)))
-      || ((rty != FFEINFO_basictypeINTEGER)
-	  && (rty != FFEINFO_basictypeREAL)))
-    {
-      if ((rty != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_INVALID_COMPLEX_PART))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ft),
-		       ffelex_token_where_column (ft));
-	  ffebad_string ("Imaginary");
-	  ffebad_finish ();
-	}
-      ok = FALSE;
-    }
-
-  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-
-  /* Push the (parenthesized) expression as an operand onto the expression
-     stack. */
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_stack_->tokens[0];
-
-  if (ok)
-    {
-      if (lty == FFEINFO_basictypeINTEGER)
-	lkt = FFEINFO_kindtypeREALDEFAULT;
-      else
-	lkt = ffeinfo_kindtype (ffebld_info (ffeexpr_stack_->expr));
-      if (rty == FFEINFO_basictypeINTEGER)
-	rkt = FFEINFO_kindtypeREALDEFAULT;
-      else
-	rkt = ffeinfo_kindtype (ffebld_info (expr));
-
-      nkt = ffeinfo_kindtype_max (FFEINFO_basictypeCOMPLEX, lkt, rkt);
-      ffeexpr_stack_->expr = ffeexpr_convert (ffeexpr_stack_->expr,
-		       ffeexpr_stack_->tokens[1], ffeexpr_stack_->tokens[0],
-		 FFEINFO_basictypeREAL, nkt, 0, FFETARGET_charactersizeNONE,
-					      FFEEXPR_contextLET);
-      expr = ffeexpr_convert (expr,
-		       ffeexpr_stack_->tokens[1], ffeexpr_stack_->tokens[0],
-		 FFEINFO_basictypeREAL, nkt, 0, FFETARGET_charactersizeNONE,
-			      FFEEXPR_contextLET);
-    }
-  else
-    nkt = FFEINFO_kindtypeANY;
-
-  switch (nkt)
-    {
-#if FFETARGET_okCOMPLEX1
-    case FFEINFO_kindtypeREAL1:
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex1
-	      (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
-
-#if FFETARGET_okCOMPLEX2
-    case FFEINFO_kindtypeREAL2:
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex2
-	      (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
-
-#if FFETARGET_okCOMPLEX3
-    case FFEINFO_kindtypeREAL3:
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_complex3
-	      (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))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	  ffebad_finish ();
-	}
-      /* Fall through. */
-    case FFEINFO_kindtypeANY:
-      e->u.operand = ffebld_new_any ();
-      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-      break;
-    }
-  ffeexpr_exprstack_push_operand_ (e);
-
-  /* Now, if the token is a close parenthese, we're in great shape so return
-     the next handler. */
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    return (ffelexHandler) ffeexpr_token_binary_;
-
-  /* Oops, naughty user didn't specify the close paren! */
-
-  if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
-    {
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-      ffebad_finish ();
-    }
-
-  return
-    (ffelexHandler) ffeexpr_find_close_paren_ (t,
-					       (ffelexHandler)
-					       ffeexpr_token_binary_);
-}
-
-/* ffeexpr_cb_close_paren_ci_ -- OPEN_PAREN expr (possible complex or
-				    implied-DO construct)
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Makes sure the end token is close-paren and swallows it, or a comma
-   and handles complex/implied-do possibilities, else issues
-   an error message and doesn't swallow the token (passing it along instead).  */
-
-static ffelexHandler
-ffeexpr_cb_close_paren_ci_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprContext ctx;
-
-  /* First check to see if this is a possible complex or implied-DO entity.
-     It is if the token is a comma. */
-
-  if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-    {
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIMPDOITEM_:
-	  ctx = FFEEXPR_contextIMPDOITEM_;
-	  break;
-
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	  ctx = FFEEXPR_contextIMPDOITEMDF_;
-	  break;
-
-	default:
-	  assert ("bad context" == NULL);
-	  ctx = FFEEXPR_contextIMPDOITEM_;
-	  break;
-	}
-
-      ffeexpr_stack_->tokens[0] = ffelex_token_use (ft);
-      ffeexpr_stack_->expr = expr;
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  ctx, ffeexpr_cb_comma_ci_);
-    }
-
-  ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
-  return (ffelexHandler) ffeexpr_cb_close_paren_ (ft, expr, t);
-}
-
-/* ffeexpr_cb_comma_ci_ -- OPEN_PAREN expr COMMA expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   If this token is not a comma, we have a complex constant (or an attempt
-   at one), so handle it accordingly, displaying error messages if the token
-   is not a close-paren.  If we have a comma here, it is an attempt at an
-   implied-DO, so start making a list accordingly.  Oh, it might be an
-   equal sign also, meaning an implied-DO with only one item in its list.  */
-
-static ffelexHandler
-ffeexpr_cb_comma_ci_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffebld fexpr;
-
-  /* First check to see if this is a possible complex constant.	 It is if the
-     token is not a comma or an equals sign, in which case it should be a
-     close-paren. */
-
-  if ((ffelex_token_type (t) != FFELEX_typeCOMMA)
-      && (ffelex_token_type (t) != FFELEX_typeEQUALS))
-    {
-      ffeexpr_stack_->tokens[1] = ffeexpr_stack_->tokens[0];
-      ffeexpr_stack_->tokens[0] = ffelex_token_use (ffeexpr_stack_->first_token);
-      return (ffelexHandler) ffeexpr_cb_comma_c_ (ft, expr, t);
-    }
-
-  /* Here we have either EQUALS or COMMA, meaning we are in an implied-DO
-     construct.	 Make a list and handle accordingly. */
-
-  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-  fexpr = ffeexpr_stack_->expr;
-  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-  ffebld_append_item (&ffeexpr_stack_->bottom, fexpr);
-  return (ffelexHandler) ffeexpr_cb_comma_i_1_ (ft, expr, t);
-}
-
-/* ffeexpr_cb_comma_i_ -- OPEN_PAREN expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Handle first item in an implied-DO construct.  */
-
-static ffelexHandler
-ffeexpr_cb_comma_i_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeCOMMA)
-    {
-      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-      ffeexpr_stack_->expr = ffebld_new_any ();
-      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
-      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
-	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
-      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
-    }
-
-  return (ffelexHandler) ffeexpr_cb_comma_i_1_ (ft, expr, t);
-}
-
-/* ffeexpr_cb_comma_i_1_ -- OPEN_PAREN expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Handle first item in an implied-DO construct.  */
-
-static ffelexHandler
-ffeexpr_cb_comma_i_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprContext ctxi;
-  ffeexprContext ctxc;
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextDATA:
-    case FFEEXPR_contextDATAIMPDOITEM_:
-      ctxi = FFEEXPR_contextDATAIMPDOITEM_;
-      ctxc = FFEEXPR_contextDATAIMPDOCTRL_;
-      break;
-
-    case FFEEXPR_contextIOLIST:
-    case FFEEXPR_contextIMPDOITEM_:
-      ctxi = FFEEXPR_contextIMPDOITEM_;
-      ctxc = FFEEXPR_contextIMPDOCTRL_;
-      break;
-
-    case FFEEXPR_contextIOLISTDF:
-    case FFEEXPR_contextIMPDOITEMDF_:
-      ctxi = FFEEXPR_contextIMPDOITEMDF_;
-      ctxc = FFEEXPR_contextIMPDOCTRL_;
-      break;
-
-    default:
-      assert ("bad context" == NULL);
-      ctxi = FFEEXPR_context;
-      ctxc = FFEEXPR_context;
-      break;
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-      if (ffeexpr_stack_->is_rhs)
-	return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					    ctxi, ffeexpr_cb_comma_i_1_);
-      return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
-					  ctxi, ffeexpr_cb_comma_i_1_);
-
-    case FFELEX_typeEQUALS:
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-
-      /* Complain if implied-DO variable in list of items to be read.  */
-
-      if ((ctxc == FFEEXPR_contextIMPDOCTRL_) && !ffeexpr_stack_->is_rhs)
-	ffeexpr_check_impdo_ (ffeexpr_stack_->expr,
-			      ffeexpr_stack_->first_token, expr, ft);
-
-      /* Set doiter flag for all appropriate SYMTERs.  */
-
-      ffeexpr_update_impdo_ (ffeexpr_stack_->expr, expr);
-
-      ffeexpr_stack_->expr = ffebld_new_impdo (ffeexpr_stack_->expr, NULL);
-      ffebld_set_info (ffeexpr_stack_->expr,
-		       ffeinfo_new (FFEINFO_basictypeNONE,
-				    FFEINFO_kindtypeNONE,
-				    0,
-				    FFEINFO_kindNONE,
-				    FFEINFO_whereNONE,
-				    FFETARGET_charactersizeNONE));
-      ffebld_init_list (&(ffebld_right (ffeexpr_stack_->expr)),
-			&ffeexpr_stack_->bottom);
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  ctxc, ffeexpr_cb_comma_i_2_);
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-      ffeexpr_stack_->expr = ffebld_new_any ();
-      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
-      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
-	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
-      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
-    }
-}
-
-/* ffeexpr_cb_comma_i_2_ -- OPEN_PAREN expr-list EQUALS expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Handle start-value in an implied-DO construct.  */
-
-static ffelexHandler
-ffeexpr_cb_comma_i_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  ffeexprContext ctx;
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextDATA:
-    case FFEEXPR_contextDATAIMPDOITEM_:
-      ctx = FFEEXPR_contextDATAIMPDOCTRL_;
-      break;
-
-    case FFEEXPR_contextIOLIST:
-    case FFEEXPR_contextIOLISTDF:
-    case FFEEXPR_contextIMPDOITEM_:
-    case FFEEXPR_contextIMPDOITEMDF_:
-      ctx = FFEEXPR_contextIMPDOCTRL_;
-      break;
-
-    default:
-      assert ("bad context" == NULL);
-      ctx = FFEEXPR_context;
-      break;
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  ctx, ffeexpr_cb_comma_i_3_);
-      break;
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-      ffeexpr_stack_->expr = ffebld_new_any ();
-      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
-      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
-	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
-      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
-    }
-}
-
-/* ffeexpr_cb_comma_i_3_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Handle end-value in an implied-DO construct.	 */
-
-static ffelexHandler
-ffeexpr_cb_comma_i_3_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  ffeexprContext ctx;
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextDATA:
-    case FFEEXPR_contextDATAIMPDOITEM_:
-      ctx = FFEEXPR_contextDATAIMPDOCTRL_;
-      break;
-
-    case FFEEXPR_contextIOLIST:
-    case FFEEXPR_contextIOLISTDF:
-    case FFEEXPR_contextIMPDOITEM_:
-    case FFEEXPR_contextIMPDOITEMDF_:
-      ctx = FFEEXPR_contextIMPDOCTRL_;
-      break;
-
-    default:
-      assert ("bad context" == NULL);
-      ctx = FFEEXPR_context;
-      break;
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  ctx, ffeexpr_cb_comma_i_4_);
-      break;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-      return (ffelexHandler) ffeexpr_cb_comma_i_4_ (NULL, NULL, t);
-      break;
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-      ffeexpr_stack_->expr = ffebld_new_any ();
-      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
-      if (ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
-	return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
-      return (ffelexHandler) ffeexpr_cb_comma_i_5_;
-    }
-}
-
-/* ffeexpr_cb_comma_i_4_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
-			       [COMMA expr]
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Handle incr-value in an implied-DO construct.  */
-
-static ffelexHandler
-ffeexpr_cb_comma_i_4_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-      {
-	ffebld item;
-
-	for (item = ffebld_left (ffeexpr_stack_->expr);
-	     item != NULL;
-	     item = ffebld_trail (item))
-	  if (ffebld_op (ffebld_head (item)) == FFEBLD_opANY)
-	    goto replace_with_any;	/* :::::::::::::::::::: */
-
-	for (item = ffebld_right (ffeexpr_stack_->expr);
-	     item != NULL;
-	     item = ffebld_trail (item))
-	  if ((ffebld_head (item) != NULL)	/* Increment may be NULL. */
-	      && (ffebld_op (ffebld_head (item)) == FFEBLD_opANY))
-	    goto replace_with_any;	/* :::::::::::::::::::: */
-      }
-      break;
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_BAD_IMPDO))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffebld_end_list (&ffeexpr_stack_->bottom);
-
-    replace_with_any:		/* :::::::::::::::::::: */
-
-      ffeexpr_stack_->expr = ffebld_new_any ();
-      ffebld_set_info (ffeexpr_stack_->expr, ffeinfo_new_any ());
-      break;
-    }
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    return (ffelexHandler) ffeexpr_cb_comma_i_5_;
-  return (ffelexHandler) ffeexpr_cb_comma_i_5_ (t);
-}
-
-/* ffeexpr_cb_comma_i_5_ -- OPEN_PAREN expr-list EQUALS expr COMMA expr
-			       [COMMA expr] CLOSE_PAREN
-
-   Pass it to ffeexpr_rhs as the callback routine.
-
-   Collects token following implied-DO construct for callback function.	 */
-
-static ffelexHandler
-ffeexpr_cb_comma_i_5_ (ffelexToken t)
-{
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken ft;
-  ffebld expr;
-  bool terminate;
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextDATA:
-    case FFEEXPR_contextDATAIMPDOITEM_:
-      terminate = TRUE;
-      break;
-
-    case FFEEXPR_contextIOLIST:
-    case FFEEXPR_contextIOLISTDF:
-    case FFEEXPR_contextIMPDOITEM_:
-    case FFEEXPR_contextIMPDOITEMDF_:
-      terminate = FALSE;
-      break;
-
-    default:
-      assert ("bad context" == NULL);
-      terminate = FALSE;
-      break;
-    }
-
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ft = ffeexpr_stack_->first_token;
-  expr = ffeexpr_stack_->expr;
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
-		  sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  next = (ffelexHandler) (*callback) (ft, expr, t);
-  ffelex_token_kill (ft);
-  if (terminate)
-    {
-      ffesymbol_drive_sfnames (ffeexpr_check_impctrl_);
-      --ffeexpr_level_;
-      if (ffeexpr_level_ == 0)
-	ffe_terminate_4 ();
-    }
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_cb_end_loc_ -- Handle end of %LOC subexpression
-
-   Makes sure the end token is close-paren and swallows it, else issues
-   an error message and doesn't swallow the token (passing it along instead).
-   In either case wraps up subexpression construction by enclosing the
-   ffebld expression in a %LOC.	 */
-
-static ffelexHandler
-ffeexpr_cb_end_loc_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  /* First push the (%LOC) expression as an operand onto the expression
-     stack. */
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_stack_->tokens[0];
-  e->u.operand = ffebld_new_percent_loc (expr);
-  ffebld_set_info (e->u.operand,
-		   ffeinfo_new (FFEINFO_basictypeINTEGER,
-				ffecom_pointer_kind (),
-				0,
-				FFEINFO_kindENTITY,
-				FFEINFO_whereFLEETING,
-				FFETARGET_charactersizeNONE));
-#if 0				/* ~~ */
-  e->u.operand = ffeexpr_collapse_percent_loc (e->u.operand, ft);
-#endif
-  ffeexpr_exprstack_push_operand_ (e);
-
-  /* Now, if the token is a close parenthese, we're in great shape so return
-     the next handler. */
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    {
-      ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-      return (ffelexHandler) ffeexpr_token_binary_;
-    }
-
-  /* Oops, naughty user didn't specify the close paren! */
-
-  if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
-      ffebad_finish ();
-    }
-
-  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-  return
-    (ffelexHandler) ffeexpr_find_close_paren_ (t,
-					       (ffelexHandler)
-					       ffeexpr_token_binary_);
-}
-
-/* ffeexpr_cb_end_notloc_ -- PERCENT NAME(VAL,REF,DESCR) OPEN_PAREN expr
-
-   Should be CLOSE_PAREN, and make sure expr isn't a %(VAL,REF,DESCR).  */
-
-static ffelexHandler
-ffeexpr_cb_end_notloc_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffebldOp op;
-
-  /* If expression is itself a %(VAL,REF,DESCR), complain and strip off all
-     such things until the lowest-level expression is reached.  */
-
-  op = ffebld_op (expr);
-  if ((op == FFEBLD_opPERCENT_VAL) || (op == FFEBLD_opPERCENT_REF)
-      || (op == FFEBLD_opPERCENT_DESCR))
-    {
-      if (ffebad_start (FFEBAD_NESTED_PERCENT))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ft),
-		       ffelex_token_where_column (ft));
-	  ffebad_finish ();
-	}
-
-      do
-	{
-	  expr = ffebld_left (expr);
-	  op = ffebld_op (expr);
-	}
-      while ((op == FFEBLD_opPERCENT_VAL) || (op == FFEBLD_opPERCENT_REF)
-	     || (op == FFEBLD_opPERCENT_DESCR));
-    }
-
-  /* Push the expression as an operand onto the expression stack. */
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_stack_->tokens[0];
-  switch (ffeexpr_stack_->percent)
-    {
-    case FFEEXPR_percentVAL_:
-      e->u.operand = ffebld_new_percent_val (expr);
-      break;
-
-    case FFEEXPR_percentREF_:
-      e->u.operand = ffebld_new_percent_ref (expr);
-      break;
-
-    case FFEEXPR_percentDESCR_:
-      e->u.operand = ffebld_new_percent_descr (expr);
-      break;
-
-    default:
-      assert ("%lossage" == NULL);
-      e->u.operand = expr;
-      break;
-    }
-  ffebld_set_info (e->u.operand, ffebld_info (expr));
-#if 0				/* ~~ */
-  e->u.operand = ffeexpr_collapse_percent_ ? ? ? (e->u.operand, ft);
-#endif
-  ffeexpr_exprstack_push_operand_ (e);
-
-  /* Now, if the token is a close parenthese, we're in great shape so return
-     the next handler. */
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    return (ffelexHandler) ffeexpr_cb_end_notloc_1_;
-
-  /* Oops, naughty user didn't specify the close paren! */
-
-  if (ffest_ffebad_start (FFEBAD_MISSING_CLOSE_PAREN))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
-      ffebad_finish ();
-    }
-
-  ffebld_set_op (e->u.operand, FFEBLD_opPERCENT_LOC);
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextINDEXORACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-      break;
-
-    default:
-      assert ("bad context?!?!" == NULL);
-      break;
-    }
-
-  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-  return
-    (ffelexHandler) ffeexpr_find_close_paren_ (t,
-					       (ffelexHandler)
-					       ffeexpr_cb_end_notloc_1_);
-}
-
-/* ffeexpr_cb_end_notloc_1_ -- PERCENT NAME(VAL,REF,DESCR) OPEN_PAREN expr
-   CLOSE_PAREN
-
-   Should be COMMA or CLOSE_PAREN, else change back to %LOC.  */
-
-static ffelexHandler
-ffeexpr_cb_end_notloc_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  break;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
-	  break;
-
-	default:
-	  assert ("bad context?!?!" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      if (ffebad_start (FFEBAD_INVALID_PERCENT))
-	{
-	  ffebad_here (0,
-		       ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_string (ffelex_token_text (ffeexpr_stack_->tokens[1]));
-	  ffebad_finish ();
-	}
-
-      ffebld_set_op (ffeexpr_stack_->exprstack->u.operand,
-		     FFEBLD_opPERCENT_LOC);
-
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-	  break;
-
-	default:
-	  assert ("bad context?!?!" == NULL);
-	  break;
-	}
-    }
-
-  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-  return
-    (ffelexHandler) ffeexpr_token_binary_ (t);
-}
-
-/* Process DATA implied-DO iterator variables as this implied-DO level
-   terminates.  At this point, ffeexpr_level_ == 1 when we see the
-   last right-paren in "DATA (A(I),I=1,10)/.../".  */
-
-static ffesymbol
-ffeexpr_check_impctrl_ (ffesymbol s)
-{
-  assert (s != NULL);
-  assert (ffesymbol_sfdummyparent (s) != NULL);
-
-  switch (ffesymbol_state (s))
-    {
-    case FFESYMBOL_stateNONE:	/* Used as iterator already. Now let symbol
-				   be used as iterator at any level at or
-				   innermore than the outermost of the
-				   current level and the symbol's current
-				   level. */
-      if (ffeexpr_level_ < ffesymbol_maxentrynum (s))
-	{
-	  ffesymbol_signal_change (s);
-	  ffesymbol_set_maxentrynum (s, ffeexpr_level_);
-	  ffesymbol_signal_unreported (s);
-	}
-      break;
-
-    case FFESYMBOL_stateSEEN:	/* Seen already in this or other implied-DO.
-				   Error if at outermost level, else it can
-				   still become an iterator. */
-      if ((ffeexpr_level_ == 1)
-	  && ffebad_start (FFEBAD_BAD_IMPDCL))
-	{
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
-	  ffebad_finish ();
-	}
-      break;
-
-    case FFESYMBOL_stateUNCERTAIN:	/* Iterator. */
-      assert (ffeexpr_level_ <= ffesymbol_maxentrynum (s));
-      ffesymbol_signal_change (s);
-      ffesymbol_set_state (s, FFESYMBOL_stateNONE);
-      ffesymbol_signal_unreported (s);
-      break;
-
-    case FFESYMBOL_stateUNDERSTOOD:
-      break;			/* ANY. */
-
-    default:
-      assert ("Sasha Foo!!" == NULL);
-      break;
-    }
-
-  return s;
-}
-
-/* Issue diagnostic if implied-DO variable appears in list of lhs
-   expressions (as in "READ *, (I,I=1,10)").  */
-
-static void
-ffeexpr_check_impdo_ (ffebld list, ffelexToken list_t,
-		      ffebld dovar, ffelexToken dovar_t)
-{
-  ffebld item;
-  ffesymbol dovar_sym;
-  int itemnum;
-
-  if (ffebld_op (dovar) != FFEBLD_opSYMTER)
-    return;			/* Presumably opANY. */
-
-  dovar_sym = ffebld_symter (dovar);
-
-  for (itemnum = 1; list != NULL; list = ffebld_trail (list), ++itemnum)
-    {
-      if (((item = ffebld_head (list)) != NULL)
-	  && (ffebld_op (item) == FFEBLD_opSYMTER)
-	  && (ffebld_symter (item) == dovar_sym))
-	{
-	  char itemno[20];
-
-	  sprintf (&itemno[0], "%d", itemnum);
-	  if (ffebad_start (FFEBAD_DOITER_IMPDO))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (list_t),
-			   ffelex_token_where_column (list_t));
-	      ffebad_here (1, ffelex_token_where_line (dovar_t),
-			   ffelex_token_where_column (dovar_t));
-	      ffebad_string (ffesymbol_text (dovar_sym));
-	      ffebad_string (itemno);
-	      ffebad_finish ();
-	    }
-	}
-    }
-}
-
-/* Decorate any SYMTERs referencing the DO variable with the "doiter"
-   flag.  */
-
-static void
-ffeexpr_update_impdo_ (ffebld list, ffebld dovar)
-{
-  ffesymbol dovar_sym;
-
-  if (ffebld_op (dovar) != FFEBLD_opSYMTER)
-    return;			/* Presumably opANY. */
-
-  dovar_sym = ffebld_symter (dovar);
-
-  ffeexpr_update_impdo_sym_ (list, dovar_sym);	/* Recurse! */
-}
-
-/* Recursive function to update any expr so SYMTERs have "doiter" flag
-   if they refer to the given variable.	 */
-
-static void
-ffeexpr_update_impdo_sym_ (ffebld expr, ffesymbol dovar)
-{
-  tail_recurse:			/* :::::::::::::::::::: */
-
-  if (expr == NULL)
-    return;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opSYMTER:
-      if (ffebld_symter (expr) == dovar)
-	ffebld_symter_set_is_doiter (expr, TRUE);
-      break;
-
-    case FFEBLD_opITEM:
-      ffeexpr_update_impdo_sym_ (ffebld_head (expr), dovar);
-      expr = ffebld_trail (expr);
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    default:
-      break;
-    }
-
-  switch (ffebld_arity (expr))
-    {
-    case 2:
-      ffeexpr_update_impdo_sym_ (ffebld_left (expr), dovar);
-      expr = ffebld_right (expr);
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    case 1:
-      expr = ffebld_left (expr);
-      goto tail_recurse;	/* :::::::::::::::::::: */
-
-    default:
-      break;
-    }
-
-  return;
-}
-
-/* ffeexpr_context_outer_ -- Determine context of stack entry, skipping PARENs
-
-   if (ffeexpr_context_outer_(ffeexpr_stack_) == FFEEXPR_contextIF)
-       // After zero or more PAREN_ contexts, an IF context exists  */
-
-static ffeexprContext
-ffeexpr_context_outer_ (ffeexprStack_ s)
-{
-  assert (s != NULL);
-
-  for (;;)
-    {
-      switch (s->context)
-	{
-	case FFEEXPR_contextPAREN_:
-	case FFEEXPR_contextPARENFILENUM_:
-	case FFEEXPR_contextPARENFILEUNIT_:
-	  break;
-
-	default:
-	  return s->context;
-	}
-      s = s->previous;
-      assert (s != NULL);
-    }
-}
-
-/* ffeexpr_percent_ -- Look up name in list of %FOO possibilities
-
-   ffeexprPercent_ p;
-   ffelexToken t;
-   p = ffeexpr_percent_(t);
-
-   Returns the identifier for the name, or the NONE identifier.	 */
-
-static ffeexprPercent_
-ffeexpr_percent_ (ffelexToken t)
-{
-  const char *p;
-
-  switch (ffelex_token_length (t))
-    {
-    case 3:
-      switch (*(p = ffelex_token_text (t)))
-	{
-	case FFESRC_CASE_MATCH_INIT ('L', 'l', match_3l, no_match_3):
-	  if ((ffesrc_char_match_noninit (*++p, 'O', 'o'))
-	      && (ffesrc_char_match_noninit (*++p, 'C', 'c')))
-	    return FFEEXPR_percentLOC_;
-	  return FFEEXPR_percentNONE_;
-
-	case FFESRC_CASE_MATCH_INIT ('R', 'r', match_3r, no_match_3):
-	  if ((ffesrc_char_match_noninit (*++p, 'E', 'e'))
-	      && (ffesrc_char_match_noninit (*++p, 'F', 'f')))
-	    return FFEEXPR_percentREF_;
-	  return FFEEXPR_percentNONE_;
-
-	case FFESRC_CASE_MATCH_INIT ('V', 'v', match_3v, no_match_3):
-	  if ((ffesrc_char_match_noninit (*++p, 'A', 'a'))
-	      && (ffesrc_char_match_noninit (*++p, 'L', 'l')))
-	    return FFEEXPR_percentVAL_;
-	  return FFEEXPR_percentNONE_;
-
-	default:
-	no_match_3:		/* :::::::::::::::::::: */
-	  return FFEEXPR_percentNONE_;
-	}
-
-    case 5:
-      if (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DESCR",
-			    "descr", "Descr") == 0)
-	return FFEEXPR_percentDESCR_;
-      return FFEEXPR_percentNONE_;
-
-    default:
-      return FFEEXPR_percentNONE_;
-    }
-}
-
-/* ffeexpr_type_combine -- Binop combine types, check for mythical new COMPLEX
-
-   See prototype.
-
-   If combining the two basictype/kindtype pairs produces a COMPLEX with an
-   unsupported kind type, complain and use the default kind type for
-   COMPLEX.  */
-
-void
-ffeexpr_type_combine (ffeinfoBasictype *xnbt, ffeinfoKindtype *xnkt,
-		      ffeinfoBasictype lbt, ffeinfoKindtype lkt,
-		      ffeinfoBasictype rbt, ffeinfoKindtype rkt,
-		      ffelexToken t)
-{
-  ffeinfoBasictype nbt;
-  ffeinfoKindtype nkt;
-
-  nbt = ffeinfo_basictype_combine (lbt, rbt);
-  if ((nbt == FFEINFO_basictypeCOMPLEX)
-      && ((lbt == nbt) || (lbt == FFEINFO_basictypeREAL))
-      && ((rbt == nbt) || (rbt == FFEINFO_basictypeREAL)))
-    {
-      nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
-      if (ffe_is_pedantic_not_90 () && (nkt == FFEINFO_kindtypeREALDOUBLE))
-	nkt = FFEINFO_kindtypeNONE;	/* Force error. */
-      switch (nkt)
-	{
-#if FFETARGET_okCOMPLEX1
-	case FFEINFO_kindtypeREAL1:
-#endif
-#if FFETARGET_okCOMPLEX2
-	case FFEINFO_kindtypeREAL2:
-#endif
-#if FFETARGET_okCOMPLEX3
-	case FFEINFO_kindtypeREAL3:
-#endif
-	  break;		/* Fine and dandy. */
-
-	default:
-	  if (t != NULL)
-	    {
-	      ffebad_start ((nkt == FFEINFO_kindtypeREALDOUBLE)
-			    ? FFEBAD_BAD_DBLCMPLX : FFEBAD_BAD_COMPLEX);
-	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	      ffebad_finish ();
-	    }
-	  nbt = FFEINFO_basictypeNONE;
-	  nkt = FFEINFO_kindtypeNONE;
-	  break;
-
-	case FFEINFO_kindtypeANY:
-	  nkt = FFEINFO_kindtypeREALDEFAULT;
-	  break;
-	}
-    }
-  else
-    {				/* The normal stuff. */
-      if (nbt == lbt)
-	{
-	  if (nbt == rbt)
-	    nkt = ffeinfo_kindtype_max (nbt, lkt, rkt);
-	  else
-	    nkt = lkt;
-	}
-      else if (nbt == rbt)
-	nkt = rkt;
-      else
-	{			/* Let the caller do the complaining. */
-	  nbt = FFEINFO_basictypeNONE;
-	  nkt = FFEINFO_kindtypeNONE;
-	}
-    }
-
-  /* Always a good idea to avoid aliasing problems.  */
-
-  *xnbt = nbt;
-  *xnkt = nkt;
-}
-
-/* ffeexpr_token_first_lhs_ -- First state for lhs expression
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Record line and column of first token in expression, then invoke the
-   initial-state lhs handler.  */
-
-static ffelexHandler
-ffeexpr_token_first_lhs_ (ffelexToken t)
-{
-  ffeexpr_stack_->first_token = ffelex_token_use (t);
-
-  /* When changing the list of valid initial lhs tokens, check whether to
-     update a corresponding list in ffeexpr_cb_close_paren_ambig_1_ for the
-     READ (expr) <token> case -- it assumes it knows which tokens <token> can
-     be to indicate an lhs (or implied DO), which right now is the set
-     {NAME,OPEN_PAREN}.
-
-     This comment also appears in ffeexpr_token_lhs_. */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextDATA:
-	  ffe_init_4 ();
-	  ffeexpr_level_ = 1;	/* Level of DATA implied-DO construct. */
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
-			FFEEXPR_contextDATAIMPDOITEM_, ffeexpr_cb_comma_i_);
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  ++ffeexpr_level_;	/* Level of DATA implied-DO construct. */
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
-			FFEEXPR_contextDATAIMPDOITEM_, ffeexpr_cb_comma_i_);
-
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIMPDOITEM_:
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
-			    FFEEXPR_contextIMPDOITEM_, ffeexpr_cb_comma_i_);
-
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  return (ffelexHandler) ffeexpr_lhs (ffeexpr_stack_->pool,
-			  FFEEXPR_contextIMPDOITEMDF_, ffeexpr_cb_comma_i_);
-
-	case FFEEXPR_contextFILEEXTFUNC:
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_lhs_1_;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFELEX_typeNAME:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILENAMELIST:
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_namelist_;
-
-	case FFEEXPR_contextFILEEXTFUNC:
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_lhs_1_;
-
-	default:
-	  break;
-	}
-      break;
-
-    default:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILEEXTFUNC:
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_lhs_1_;
-
-	default:
-	  break;
-	}
-      break;
-    }
-
-  return (ffelexHandler) ffeexpr_token_lhs_ (t);
-}
-
-/* ffeexpr_token_first_lhs_1_ -- NAME
-
-   return ffeexpr_token_first_lhs_1_;  // to lexer
-
-   Handle NAME as an external function (USEROPEN= VXT extension to OPEN
-   statement).	*/
-
-static ffelexHandler
-ffeexpr_token_first_lhs_1_ (ffelexToken t)
-{
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken ft;
-  ffesymbol sy = NULL;
-  ffebld expr;
-
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ft = ffeexpr_stack_->first_token;
-  s = ffeexpr_stack_->previous;
-
-  if ((ffelex_token_type (ft) != FFELEX_typeNAME)
-      || (ffesymbol_attrs (sy = ffeexpr_declare_unadorned_ (ft, FALSE))
-	  & FFESYMBOL_attrANY))
-    {
-      if ((ffelex_token_type (ft) != FFELEX_typeNAME)
-	  || !(ffesymbol_attrs (sy) & FFESYMBOL_attrsANY))
-	{
-	  ffebad_start (FFEBAD_EXPR_WRONG);
-	  ffebad_here (0, ffelex_token_where_line (ft),
-		       ffelex_token_where_column (ft));
-	  ffebad_finish ();
-	}
-      expr = ffebld_new_any ();
-      ffebld_set_info (expr, ffeinfo_new_any ());
-    }
-  else
-    {
-      expr = ffebld_new_symter (sy, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-				FFEINTRIN_impNONE);
-      ffebld_set_info (expr, ffesymbol_info (sy));
-    }
-
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
-		  sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-
-  next = (ffelexHandler) (*callback) (ft, expr, t);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_token_first_rhs_ -- First state for rhs expression
-
-   Record line and column of first token in expression, then invoke the
-   initial-state rhs handler.
-
-   19-Feb-91  JCB  1.1
-      Allow ASTERISK in PARENFILEUNIT_ case, but only on second level only
-      (i.e. only as in READ(*), not READ((*))).	 */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_ (ffelexToken t)
-{
-  ffesymbol s;
-
-  ffeexpr_stack_->first_token = ffelex_token_use (t);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeASTERISK:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILEFORMATNML:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  /* Fall through.  */
-	case FFEEXPR_contextFILEUNIT:
-	case FFEEXPR_contextDIMLIST:
-	case FFEEXPR_contextFILEFORMAT:
-	case FFEEXPR_contextCHARACTERSIZE:
-	  if (ffeexpr_stack_->previous != NULL)
-	    break;		/* Valid only on first level. */
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_rhs_1_;
-
-	case FFEEXPR_contextPARENFILEUNIT_:
-	  if (ffeexpr_stack_->previous->previous != NULL)
-	    break;		/* Valid only on second level. */
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_rhs_1_;
-
-	case FFEEXPR_contextACTUALARG_:
-	  if (ffeexpr_stack_->previous->context
-	      != FFEEXPR_contextSUBROUTINEREF)
-	    {
-	      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-	      break;
-	    }
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_rhs_3_;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFELEX_typeOPEN_PAREN:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILENUMAMBIG:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextPARENFILENUM_,
-					      ffeexpr_cb_close_paren_ambig_);
-
-	case FFEEXPR_contextFILEUNITAMBIG:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextPARENFILEUNIT_,
-					      ffeexpr_cb_close_paren_ambig_);
-
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIMPDOITEM_:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextIMPDOITEM_,
-					      ffeexpr_cb_close_paren_ci_);
-
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextIMPDOITEMDF_,
-					      ffeexpr_cb_close_paren_ci_);
-
-	case FFEEXPR_contextFILEFORMATNML:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	case FFEEXPR_contextACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFELEX_typeNUMBER:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILEFORMATNML:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  /* Fall through.  */
-	case FFEEXPR_contextFILEFORMAT:
-	  if (ffeexpr_stack_->previous != NULL)
-	    break;		/* Valid only on first level. */
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  return (ffelexHandler) ffeexpr_token_first_rhs_2_;
-
-	case FFEEXPR_contextACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFELEX_typeNAME:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFILEFORMATNML:
-	  assert (ffeexpr_stack_->exprstack == NULL);
-	  s = ffesymbol_lookup_local (t);
-	  if ((s != NULL) && (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
-	    return (ffelexHandler) ffeexpr_token_namelist_;
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFELEX_typePERCENT:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextACTUALARG_:
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  return (ffelexHandler) ffeexpr_token_first_rhs_5_;
-
-	case FFEEXPR_contextFILEFORMATNML:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	default:
-	  break;
-	}
-
-    default:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextFILEFORMATNML:
-	  ffeexpr_stack_->context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-    }
-
-  return (ffelexHandler) ffeexpr_token_rhs_ (t);
-}
-
-/* ffeexpr_token_first_rhs_1_ -- ASTERISK
-
-   return ffeexpr_token_first_rhs_1_;  // to lexer
-
-   Return STAR as expression.  */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_1_ (ffelexToken t)
-{
-  ffebld expr;
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken ft;
-
-  expr = ffebld_new_star ();
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ft = ffeexpr_stack_->first_token;
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  next = (ffelexHandler) (*callback) (ft, expr, t);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_token_first_rhs_2_ -- NUMBER
-
-   return ffeexpr_token_first_rhs_2_;  // to lexer
-
-   Return NULL as expression; NUMBER as first (and only) token, unless the
-   current token is not a terminating token, in which case run normal
-   expression handling.	 */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_2_ (ffelexToken t)
-{
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken ft;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      break;
-
-    default:
-      next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
-      return (ffelexHandler) (*next) (t);
-    }
-
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ft = ffeexpr_stack_->first_token;
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
-		  sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  next = (ffelexHandler) (*callback) (ft, NULL, t);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_token_first_rhs_3_ -- ASTERISK
-
-   return ffeexpr_token_first_rhs_3_;  // to lexer
-
-   Expect NUMBER, make LABTOK (with copy of token if not inhibited after
-   confirming, else NULL).  */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_3_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    {				/* An error, but let normal processing handle
-				   it. */
-      next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
-      return (ffelexHandler) (*next) (t);
-    }
-
-  /* Special case: when we see "*10" as an argument to a subroutine
-     reference, we confirm the current statement and, if not inhibited at
-     this point, put a copy of the token into a LABTOK node.  We do this
-     instead of just resolving the label directly via ffelab and putting it
-     into a LABTER simply to improve error reporting and consistency in
-     ffestc.  We put NULL in the LABTOK if we're still inhibited, so ffestb
-     doesn't have to worry about killing off any tokens when retracting. */
-
-  ffest_confirmed ();
-  if (ffest_is_inhibited ())
-    ffeexpr_stack_->expr = ffebld_new_labtok (NULL);
-  else
-    ffeexpr_stack_->expr = ffebld_new_labtok (ffelex_token_use (t));
-  ffebld_set_info (ffeexpr_stack_->expr,
-		   ffeinfo_new (FFEINFO_basictypeNONE,
-				FFEINFO_kindtypeNONE,
-				0,
-				FFEINFO_kindNONE,
-				FFEINFO_whereNONE,
-				FFETARGET_charactersizeNONE));
-
-  return (ffelexHandler) ffeexpr_token_first_rhs_4_;
-}
-
-/* ffeexpr_token_first_rhs_4_ -- ASTERISK NUMBER
-
-   return ffeexpr_token_first_rhs_4_;  // to lexer
-
-   Collect/flush appropriate stuff, send token to callback function.  */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_4_ (ffelexToken t)
-{
-  ffebld expr;
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken ft;
-
-  expr = ffeexpr_stack_->expr;
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ft = ffeexpr_stack_->first_token;
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  next = (ffelexHandler) (*callback) (ft, expr, t);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_token_first_rhs_5_ -- PERCENT
-
-   Should be NAME, or pass through original mechanism.  If NAME is LOC,
-   pass through original mechanism, otherwise must be VAL, REF, or DESCR,
-   in which case handle the argument (in parentheses), etc.  */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_5_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  if (ffelex_token_type (t) == FFELEX_typeNAME)
-    {
-      ffeexprPercent_ p = ffeexpr_percent_ (t);
-
-      switch (p)
-	{
-	case FFEEXPR_percentNONE_:
-	case FFEEXPR_percentLOC_:
-	  break;		/* Treat %LOC as any other expression. */
-
-	case FFEEXPR_percentVAL_:
-	case FFEEXPR_percentREF_:
-	case FFEEXPR_percentDESCR_:
-	  ffeexpr_stack_->percent = p;
-	  ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
-	  return (ffelexHandler) ffeexpr_token_first_rhs_6_;
-
-	default:
-	  assert ("bad percent?!?" == NULL);
-	  break;
-	}
-    }
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextINDEXORACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-      break;
-
-    default:
-      assert ("bad context?!?!" == NULL);
-      break;
-    }
-
-  next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffeexpr_token_first_rhs_6_ -- PERCENT NAME(VAL,REF,DESCR)
-
-   Should be OPEN_PAREN, or pass through original mechanism.  */
-
-static ffelexHandler
-ffeexpr_token_first_rhs_6_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken ft;
-
-  if (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN)
-    {
-      ffeexpr_stack_->tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  ffeexpr_stack_->context,
-					  ffeexpr_cb_end_notloc_);
-    }
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextINDEXORACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-      ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-      break;
-
-    default:
-      assert ("bad context?!?!" == NULL);
-      break;
-    }
-
-  ft = ffeexpr_stack_->tokens[0];
-  next = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_stack_->first_token);
-  next = (ffelexHandler) (*next) (ft);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffeexpr_token_namelist_ -- NAME
-
-   return ffeexpr_token_namelist_;  // to lexer
-
-   Make sure NAME was a valid namelist object, wrap it in a SYMTER and
-   return.  */
-
-static ffelexHandler
-ffeexpr_token_namelist_ (ffelexToken t)
-{
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffelexHandler next;
-  ffelexToken ft;
-  ffesymbol sy;
-  ffebld expr;
-
-  ffebld_pool_pop ();
-  callback = ffeexpr_stack_->callback;
-  ft = ffeexpr_stack_->first_token;
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_, sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-
-  sy = ffesymbol_lookup_local (ft);
-  if ((sy == NULL) || (ffesymbol_kind (sy) != FFEINFO_kindNAMELIST))
-    {
-      ffebad_start (FFEBAD_EXPR_WRONG);
-      ffebad_here (0, ffelex_token_where_line (ft),
-		   ffelex_token_where_column (ft));
-      ffebad_finish ();
-      expr = ffebld_new_any ();
-      ffebld_set_info (expr, ffeinfo_new_any ());
-    }
-  else
-    {
-      expr = ffebld_new_symter (sy, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-				FFEINTRIN_impNONE);
-      ffebld_set_info (expr, ffesymbol_info (sy));
-    }
-  next = (ffelexHandler) (*callback) (ft, expr, t);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_expr_kill_ -- Kill an existing internal expression object
-
-   ffeexprExpr_ e;
-   ffeexpr_expr_kill_(e);
-
-   Kills the ffewhere info, if necessary, then kills the object.  */
-
-static void
-ffeexpr_expr_kill_ (ffeexprExpr_ e)
-{
-  if (e->token != NULL)
-    ffelex_token_kill (e->token);
-  malloc_kill_ks (ffe_pool_program_unit (), e, sizeof (*e));
-}
-
-/* ffeexpr_expr_new_ -- Make a new internal expression object
-
-   ffeexprExpr_ e;
-   e = ffeexpr_expr_new_();
-
-   Allocates and initializes a new expression object, returns it.  */
-
-static ffeexprExpr_
-ffeexpr_expr_new_ (void)
-{
-  ffeexprExpr_ e;
-
-  e = malloc_new_ks (ffe_pool_program_unit (), "FFEEXPR expr", sizeof (*e));
-  e->previous = NULL;
-  e->type = FFEEXPR_exprtypeUNKNOWN_;
-  e->token = NULL;
-  return e;
-}
-
-/* Verify that call to global is valid, and register whatever
-   new information about a global might be discoverable by looking
-   at the call.  */
-
-static void
-ffeexpr_fulfill_call_ (ffebld *expr, ffelexToken t)
-{
-  int n_args;
-  ffebld list;
-  ffebld item;
-  ffesymbol s;
-
-  assert ((ffebld_op (*expr) == FFEBLD_opSUBRREF)
-	  || (ffebld_op (*expr) == FFEBLD_opFUNCREF));
-
-  if (ffebld_op (ffebld_left (*expr)) != FFEBLD_opSYMTER)
-    return;
-
-  if (ffesymbol_retractable ())
-    return;
-
-  s = ffebld_symter (ffebld_left (*expr));
-  if (ffesymbol_global (s) == NULL)
-    return;
-
-  for (n_args = 0, list = ffebld_right (*expr);
-       list != NULL;
-       list = ffebld_trail (list), ++n_args)
-    ;
-
-  if (ffeglobal_proc_ref_nargs (s, n_args, t))
-    {
-      ffeglobalArgSummary as;
-      ffeinfoBasictype bt;
-      ffeinfoKindtype kt;
-      bool array;
-      bool fail = FALSE;
-
-      for (n_args = 0, list = ffebld_right (*expr);
-	   list != NULL;
-	   list = ffebld_trail (list), ++n_args)
-	{
-	  item = ffebld_head (list);
-	  if (item != NULL)
-	    {
-	      bt = ffeinfo_basictype (ffebld_info (item));
-	      kt = ffeinfo_kindtype (ffebld_info (item));
-	      array = (ffeinfo_rank (ffebld_info (item)) > 0);
-	      switch (ffebld_op (item))
-		{
-		case FFEBLD_opLABTOK:
-		case FFEBLD_opLABTER:
-		  as = FFEGLOBAL_argsummaryALTRTN;
-		  break;
-
-#if 0
-		  /* No, %LOC(foo) is just like any INTEGER(KIND=7)
-		     expression, so don't treat it specially.  */
-		case FFEBLD_opPERCENT_LOC:
-		  as = FFEGLOBAL_argsummaryPTR;
-		  break;
-#endif
-
-		case FFEBLD_opPERCENT_VAL:
-		  as = FFEGLOBAL_argsummaryVAL;
-		  break;
-
-		case FFEBLD_opPERCENT_REF:
-		  as = FFEGLOBAL_argsummaryREF;
-		  break;
-
-		case FFEBLD_opPERCENT_DESCR:
-		  as = FFEGLOBAL_argsummaryDESCR;
-		  break;
-
-		case FFEBLD_opFUNCREF:
-#if 0
-		  /* No, LOC(foo) is just like any INTEGER(KIND=7)
-		     expression, so don't treat it specially.  */
-		  if ((ffebld_op (ffebld_left (item)) == FFEBLD_opSYMTER)
-		      && (ffesymbol_specific (ffebld_symter (ffebld_left (item)))
-			  == FFEINTRIN_specLOC))
-		    {
-		      as = FFEGLOBAL_argsummaryPTR;
-		      break;
-		    }
-#endif
-		  /* Fall through.  */
-		default:
-		  if (ffebld_op (item) == FFEBLD_opSYMTER)
-		    {
-		      as = FFEGLOBAL_argsummaryNONE;
-
-		      switch (ffeinfo_kind (ffebld_info (item)))
-			{
-			case FFEINFO_kindFUNCTION:
-			  as = FFEGLOBAL_argsummaryFUNC;
-			  break;
-
-			case FFEINFO_kindSUBROUTINE:
-			  as = FFEGLOBAL_argsummarySUBR;
-			  break;
-
-			case FFEINFO_kindNONE:
-			  as = FFEGLOBAL_argsummaryPROC;
-			  break;
-
-			default:
-			  break;
-			}
-
-		      if (as != FFEGLOBAL_argsummaryNONE)
-			break;
-		    }
-
-		  if (bt == FFEINFO_basictypeCHARACTER)
-		    as = FFEGLOBAL_argsummaryDESCR;
-		  else
-		    as = FFEGLOBAL_argsummaryREF;
-		  break;
-		}
-	    }
-	  else
-	    {
-	      array = FALSE;
-	      as = FFEGLOBAL_argsummaryNONE;
-	      bt = FFEINFO_basictypeNONE;
-	      kt = FFEINFO_kindtypeNONE;
-	    }
-
-	  if (! ffeglobal_proc_ref_arg (s, n_args, as, bt, kt, array, t))
-	    fail = TRUE;
-	}
-      if (! fail)
-	return;
-    }
-
-  *expr = ffebld_new_any ();
-  ffebld_set_info (*expr, ffeinfo_new_any ());
-}
-
-/* Check whether rest of string is all decimal digits.  */
-
-static bool
-ffeexpr_isdigits_ (const char *p)
-{
-  for (; *p != '\0'; ++p)
-    if (! ISDIGIT (*p))
-      return FALSE;
-  return TRUE;
-}
-
-/* ffeexpr_exprstack_push_ -- Push an arbitrary expression object onto the stack
-
-   ffeexprExpr_ e;
-   ffeexpr_exprstack_push_(e);
-
-   Pushes the expression onto the stack without any analysis of the existing
-   contents of the stack.  */
-
-static void
-ffeexpr_exprstack_push_ (ffeexprExpr_ e)
-{
-  e->previous = ffeexpr_stack_->exprstack;
-  ffeexpr_stack_->exprstack = e;
-}
-
-/* ffeexpr_exprstack_push_operand_ -- Push an operand onto the stack, reduce?
-
-   ffeexprExpr_ e;
-   ffeexpr_exprstack_push_operand_(e);
-
-   Pushes the expression already containing an operand (a constant, variable,
-   or more complicated expression that has already been fully resolved) after
-   analyzing the stack and checking for possible reduction (which will never
-   happen here since the highest precedence operator is ** and it has right-
-   to-left associativity).  */
-
-static void
-ffeexpr_exprstack_push_operand_ (ffeexprExpr_ e)
-{
-  ffeexpr_exprstack_push_ (e);
-}
-
-/* ffeexpr_exprstack_push_unary_ -- Push a unary operator onto the stack
-
-   ffeexprExpr_ e;
-   ffeexpr_exprstack_push_unary_(e);
-
-   Pushes the expression already containing a unary operator.  Reduction can
-   never happen since unary operators are themselves always R-L; that is, the
-   top of the expression stack is not an operand, in that it is either empty,
-   has a binary operator at the top, or a unary operator at the top.  In any
-   of these cases, reduction is impossible.  */
-
-static void
-ffeexpr_exprstack_push_unary_ (ffeexprExpr_ e)
-{
-  if ((ffe_is_pedantic ()
-       || ffe_is_warn_surprising ())
-      && (ffeexpr_stack_->exprstack != NULL)
-      && (ffeexpr_stack_->exprstack->type != FFEEXPR_exprtypeOPERAND_)
-      && (ffeexpr_stack_->exprstack->u.operator.prec
-	  <= FFEEXPR_operatorprecedenceLOWARITH_)
-      && (e->u.operator.prec <= FFEEXPR_operatorprecedenceLOWARITH_))
-    {
-      /* xgettext:no-c-format */
-      ffebad_start_msg ("Two arithmetic operators in a row at %0 and %1 -- use parentheses",
-			ffe_is_pedantic ()
-			? FFEBAD_severityPEDANTIC
-			: FFEBAD_severityWARNING);
-      ffebad_here (0,
-		  ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
-	       ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
-      ffebad_here (1,
-		   ffelex_token_where_line (e->token),
-		   ffelex_token_where_column (e->token));
-      ffebad_finish ();
-    }
-
-  ffeexpr_exprstack_push_ (e);
-}
-
-/* ffeexpr_exprstack_push_binary_ -- Push a binary operator onto the stack, reduce?
-
-   ffeexprExpr_ e;
-   ffeexpr_exprstack_push_binary_(e);
-
-   Pushes the expression already containing a binary operator after checking
-   whether reduction is possible.  If the stack is not empty, the top of the
-   stack must be an operand or syntactic analysis has failed somehow.  If
-   the operand is preceded by a unary operator of higher (or equal and L-R
-   associativity) precedence than the new binary operator, then reduce that
-   preceding operator and its operand(s) before pushing the new binary
-   operator.  */
-
-static void
-ffeexpr_exprstack_push_binary_ (ffeexprExpr_ e)
-{
-  ffeexprExpr_ ce;
-
-  if (ffe_is_warn_surprising ()
-      /* These next two are always true (see assertions below).  */
-      && (ffeexpr_stack_->exprstack != NULL)
-      && (ffeexpr_stack_->exprstack->type == FFEEXPR_exprtypeOPERAND_)
-      /* If the previous operator is a unary minus, and the binary op
-	 is of higher precedence, might not do what user expects,
-	 e.g. "-2**2" is "-(2**2)", i.e. "-4", not "(-2)**2", which would
-	 yield "4".  */
-      && (ffeexpr_stack_->exprstack->previous != NULL)
-      && (ffeexpr_stack_->exprstack->previous->type == FFEEXPR_exprtypeUNARY_)
-      && (ffeexpr_stack_->exprstack->previous->u.operator.op
-	  == FFEEXPR_operatorSUBTRACT_)
-      && (e->u.operator.prec
-	  < ffeexpr_stack_->exprstack->previous->u.operator.prec))
-    {
-      /* xgettext:no-c-format */
-      ffebad_start_msg ("Operator at %0 has lower precedence than that at %1 -- use parentheses", FFEBAD_severityWARNING);
-      ffebad_here (0,
-	 ffelex_token_where_line (ffeexpr_stack_->exprstack->previous->token),
-      ffelex_token_where_column (ffeexpr_stack_->exprstack->previous->token));
-      ffebad_here (1,
-		   ffelex_token_where_line (e->token),
-		   ffelex_token_where_column (e->token));
-      ffebad_finish ();
-    }
-
-again:
-  assert (ffeexpr_stack_->exprstack != NULL);
-  assert (ffeexpr_stack_->exprstack->type == FFEEXPR_exprtypeOPERAND_);
-  if ((ce = ffeexpr_stack_->exprstack->previous) != NULL)
-    {
-      assert (ce->type != FFEEXPR_exprtypeOPERAND_);
-      if ((ce->u.operator.prec < e->u.operator.prec)
-	  || ((ce->u.operator.prec == e->u.operator.prec)
-	      && (e->u.operator.as == FFEEXPR_operatorassociativityL2R_)))
-	{
-	  ffeexpr_reduce_ ();
-	  goto again;	/* :::::::::::::::::::: */
-	}
-    }
-
-  ffeexpr_exprstack_push_ (e);
-}
-
-/* ffeexpr_reduce_ -- Reduce highest operator w/operands on stack
-
-   ffeexpr_reduce_();
-
-   Converts operand binop operand or unop operand at top of stack to a
-   single operand having the appropriate ffebld expression, and makes
-   sure that the expression is proper (like not trying to add two character
-   variables, not trying to concatenate two numbers).  Also does the
-   requisite type-assignment.  */
-
-static void
-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. */
-  ffeexprExpr_ operator;	/* This is + in A+B. */
-  ffebld reduced;		/* This is +(A,B) in A+B or u-(B) in -B. */
-  ffebldConstant constnode;	/* For checking magical numbers (where mag ==
-				   -mag). */
-  ffebld expr;
-  ffebld left_expr;
-  bool submag = FALSE;
-  bool bothlogical;
-
-  operand = ffeexpr_stack_->exprstack;
-  assert (operand != NULL);
-  assert (operand->type == FFEEXPR_exprtypeOPERAND_);
-  operator = operand->previous;
-  assert (operator != NULL);
-  assert (operator->type != FFEEXPR_exprtypeOPERAND_);
-  if (operator->type == FFEEXPR_exprtypeUNARY_)
-    {
-      expr = operand->u.operand;
-      switch (operator->u.operator.op)
-	{
-	case FFEEXPR_operatorADD_:
-	  reduced = ffebld_new_uplus (expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly1_ (reduced, operator, operand);
-	  reduced = ffeexpr_reduced_math1_ (reduced, operator, operand);
-	  reduced = ffeexpr_collapse_uplus (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorSUBTRACT_:
-	  submag = TRUE;	/* Ok to negate a magic number. */
-	  reduced = ffebld_new_uminus (expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly1_ (reduced, operator, operand);
-	  reduced = ffeexpr_reduced_math1_ (reduced, operator, operand);
-	  reduced = ffeexpr_collapse_uminus (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorNOT_:
-	  reduced = ffebld_new_not (expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly1log_ (reduced, operator, operand);
-	  reduced = ffeexpr_reduced_bool1_ (reduced, operator, operand);
-	  reduced = ffeexpr_collapse_not (reduced, operator->token);
-	  break;
-
-	default:
-	  assert ("unexpected unary op" != NULL);
-	  reduced = NULL;
-	  break;
-	}
-      if (!submag
-	  && (ffebld_op (expr) == FFEBLD_opCONTER)
-	  && (ffebld_conter_orig (expr) == NULL)
-	  && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
-	{
-	  ffetarget_integer_bad_magical (operand->token);
-	}
-      ffeexpr_stack_->exprstack = operator->previous;	/* Pops unary-op operand
-							   off stack. */
-      ffeexpr_expr_kill_ (operand);
-      operator->type = FFEEXPR_exprtypeOPERAND_;	/* Convert operator, but
-							   save */
-      operator->u.operand = reduced;	/* the line/column ffewhere info. */
-      ffeexpr_exprstack_push_operand_ (operator);	/* Push it back on
-							   stack. */
-    }
-  else
-    {
-      assert (operator->type == FFEEXPR_exprtypeBINARY_);
-      left_operand = operator->previous;
-      assert (left_operand != NULL);
-      assert (left_operand->type == FFEEXPR_exprtypeOPERAND_);
-      expr = operand->u.operand;
-      left_expr = left_operand->u.operand;
-      switch (operator->u.operator.op)
-	{
-	case FFEEXPR_operatorADD_:
-	  reduced = ffebld_new_add (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_add (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorSUBTRACT_:
-	  submag = TRUE;	/* Just to pick the right error if magic
-				   number. */
-	  reduced = ffebld_new_subtract (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_subtract (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorMULTIPLY_:
-	  reduced = ffebld_new_multiply (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_multiply (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorDIVIDE_:
-	  reduced = ffebld_new_divide (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_math2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_divide (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorPOWER_:
-	  reduced = ffebld_new_power (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_power_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_power (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorCONCATENATE_:
-	  reduced = ffebld_new_concatenate (left_expr, expr);
-	  reduced = ffeexpr_reduced_concatenate_ (reduced, left_operand, operator,
-						  operand);
-	  reduced = ffeexpr_collapse_concatenate (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorLT_:
-	  reduced = ffebld_new_lt (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
-					     operand);
-	  reduced = ffeexpr_collapse_lt (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorLE_:
-	  reduced = ffebld_new_le (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
-					     operand);
-	  reduced = ffeexpr_collapse_le (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorEQ_:
-	  reduced = ffebld_new_eq (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_eqop2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_eq (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorNE_:
-	  reduced = ffebld_new_ne (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_eqop2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_ne (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorGT_:
-	  reduced = ffebld_new_gt (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
-					     operand);
-	  reduced = ffeexpr_collapse_gt (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorGE_:
-	  reduced = ffebld_new_ge (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2_ (reduced, left_operand, operator,
-					      operand);
-	  reduced = ffeexpr_reduced_relop2_ (reduced, left_operand, operator,
-					     operand);
-	  reduced = ffeexpr_collapse_ge (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorAND_:
-	  reduced = ffebld_new_and (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 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, &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, &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, NULL);
-	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_eqv (reduced, operator->token);
-	  break;
-
-	case FFEEXPR_operatorNEQV_:
-	  reduced = ffebld_new_neqv (left_expr, expr);
-	  if (ffe_is_ugly_logint ())
-	    reduced = ffeexpr_reduced_ugly2log_ (reduced, left_operand, operator,
-						 operand, NULL);
-	  reduced = ffeexpr_reduced_bool2_ (reduced, left_operand, operator,
-					    operand);
-	  reduced = ffeexpr_collapse_neqv (reduced, operator->token);
-	  break;
-
-	default:
-	  assert ("bad bin op" == NULL);
-	  reduced = expr;
-	  break;
-	}
-      if ((ffebld_op (left_expr) == FFEBLD_opCONTER)
-	  && (ffebld_conter_orig (expr) == NULL)
-      && ffebld_constant_is_magical (constnode = ffebld_conter (left_expr)))
-	{
-	  if ((left_operand->previous != NULL)
-	      && (left_operand->previous->type != FFEEXPR_exprtypeOPERAND_)
-	      && (left_operand->previous->u.operator.op
-		  == FFEEXPR_operatorSUBTRACT_))
-	    {
-	      if (left_operand->previous->type == FFEEXPR_exprtypeUNARY_)
-		ffetarget_integer_bad_magical_precedence (left_operand->token,
-							  left_operand->previous->token,
-							  operator->token);
-	      else
-		ffetarget_integer_bad_magical_precedence_binary
-		  (left_operand->token,
-		   left_operand->previous->token,
-		   operator->token);
-	    }
-	  else
-	    ffetarget_integer_bad_magical (left_operand->token);
-	}
-      if ((ffebld_op (expr) == FFEBLD_opCONTER)
-	  && (ffebld_conter_orig (expr) == NULL)
-	  && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
-	{
-	  if (submag)
-	    ffetarget_integer_bad_magical_binary (operand->token,
-						  operator->token);
-	  else
-	    ffetarget_integer_bad_magical (operand->token);
-	}
-      ffeexpr_stack_->exprstack = left_operand->previous;	/* Pops binary-op
-								   operands off stack. */
-      ffeexpr_expr_kill_ (left_operand);
-      ffeexpr_expr_kill_ (operand);
-      operator->type = FFEEXPR_exprtypeOPERAND_;	/* Convert operator, but
-							   save */
-      operator->u.operand = reduced;	/* the line/column ffewhere info. */
-      ffeexpr_exprstack_push_operand_ (operator);	/* Push it back on
-							   stack. */
-    }
-}
-
-/* ffeexpr_reduced_bool1_ -- Wrap up reduction of NOT operator
-
-   reduced = ffeexpr_reduced_bool1_(reduced,op,r);
-
-   Makes sure the argument for reduced has basictype of
-   LOGICAL or (ugly) INTEGER.  If
-   argument has where of CONSTANT, assign where CONSTANT to
-   reduced, else assign where FLEETING.
-
-   If these requirements cannot be met, generate error message.	 */
-
-static ffebld
-ffeexpr_reduced_bool1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
-{
-  ffeinfo rinfo, ninfo;
-  ffeinfoBasictype rbt;
-  ffeinfoKindtype rkt;
-  ffeinfoRank rrk;
-  ffeinfoKind rkd;
-  ffeinfoWhere rwh, nwh;
-
-  rinfo = ffebld_info (ffebld_left (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if (((rbt == FFEINFO_basictypeLOGICAL)
-       || (ffe_is_ugly_logint () && (rbt == FFEINFO_basictypeINTEGER)))
-      && (rrk == 0))
-    {
-      switch (rwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  nwh = FFEINFO_whereCONSTANT;
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  nwh = FFEINFO_whereIMMEDIATE;
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      ninfo = ffeinfo_new (rbt, rkt, 0, FFEINFO_kindENTITY, nwh,
-			   FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      return reduced;
-    }
-
-  if ((rbt != FFEINFO_basictypeLOGICAL)
-      && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_NOT_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_NOT_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_bool2_ -- Wrap up reduction of boolean operators
-
-   reduced = ffeexpr_reduced_bool2_(reduced,l,op,r);
-
-   Makes sure the left and right arguments for reduced have basictype of
-   LOGICAL or (ugly) INTEGER.  Determine common basictype and
-   size for reduction (flag expression for combined hollerith/typeless
-   situations for later determination of effective basictype).	If both left
-   and right arguments have where of CONSTANT, assign where CONSTANT to
-   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
-   needed.  Convert typeless
-   constants to the desired type/size explicitly.
-
-   If these requirements cannot be met, generate error message.	 */
-
-static ffebld
-ffeexpr_reduced_bool2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo, ninfo;
-  ffeinfoBasictype lbt, rbt, nbt;
-  ffeinfoKindtype lkt, rkt, nkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh, nwh;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
-
-  if (((nbt == FFEINFO_basictypeLOGICAL)
-       || (ffe_is_ugly_logint () && (nbt == FFEINFO_basictypeINTEGER)))
-      && (lrk == 0) && (rrk == 0))
-    {
-      switch (lwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      nwh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
-			   FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-	      l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET));
-      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-	      r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
-						  FFEEXPR_contextLET));
-      return reduced;
-    }
-
-  if ((lbt != FFEINFO_basictypeLOGICAL)
-      && (!ffe_is_ugly_logint () || (lbt != FFEINFO_basictypeINTEGER)))
-    {
-      if ((rbt != FFEINFO_basictypeLOGICAL)
-	  && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
-	{
-	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_BOOL_ARGS_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	      ffebad_finish ();
-	    }
-	}
-      else
-	{
-	  if ((lbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_BOOL_ARG_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_finish ();
-	    }
-	}
-    }
-  else if ((rbt != FFEINFO_basictypeLOGICAL)
-	   && (!ffe_is_ugly_logint () || (rbt != FFEINFO_basictypeINTEGER)))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_BOOL_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (lrk != 0)
-    {
-      if ((lkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_BOOL_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_BOOL_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_concatenate_ -- Wrap up reduction of concatenate operator
-
-   reduced = ffeexpr_reduced_concatenate_(reduced,l,op,r);
-
-   Makes sure the left and right arguments for reduced have basictype of
-   CHARACTER and kind of SCALAR, FUNCTION, or STATEMENT FUNCTION.  Assign
-   basictype of CHARACTER and kind of SCALAR to reduced.  Calculate effective
-   size of concatenation and assign that size to reduced.  If both left and
-   right arguments have where of CONSTANT, assign where CONSTANT to reduced,
-   else assign where FLEETING.
-
-   If these requirements cannot be met, generate error message using the
-   info in l, op, and r arguments and assign basictype, size, kind, and where
-   of ANY.  */
-
-static ffebld
-ffeexpr_reduced_concatenate_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			      ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo, ninfo;
-  ffeinfoBasictype lbt, rbt, nbt;
-  ffeinfoKindtype lkt, rkt, nkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd, nkd;
-  ffeinfoWhere lwh, rwh, nwh;
-  ffetargetCharacterSize lszm, lszk, rszm, rszk, nszk;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-  lszk = ffeinfo_size (linfo);	/* Known size. */
-  lszm = ffebld_size_max (ffebld_left (reduced));
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-  rszk = ffeinfo_size (rinfo);	/* Known size. */
-  rszm = ffebld_size_max (ffebld_right (reduced));
-
-  if ((lbt == FFEINFO_basictypeCHARACTER) && (rbt == FFEINFO_basictypeCHARACTER)
-      && (lkt == rkt) && (lrk == 0) && (rrk == 0)
-      && (((lszm != FFETARGET_charactersizeNONE)
-	   && (rszm != FFETARGET_charactersizeNONE))
-	  || (ffeexpr_context_outer_ (ffeexpr_stack_)
-	      == FFEEXPR_contextLET)
-	  || (ffeexpr_context_outer_ (ffeexpr_stack_)
-	      == FFEEXPR_contextSFUNCDEF)))
-    {
-      nbt = FFEINFO_basictypeCHARACTER;
-      nkd = FFEINFO_kindENTITY;
-      if ((lszk == FFETARGET_charactersizeNONE)
-	  || (rszk == FFETARGET_charactersizeNONE))
-	nszk = FFETARGET_charactersizeNONE;	/* Ok only in rhs of LET
-						   stmt. */
-      else
-	nszk = lszk + rszk;
-
-      switch (lwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      nwh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      nkt = lkt;
-      ninfo = ffeinfo_new (nbt, nkt, 0, nkd, nwh, nszk);
-      ffebld_set_info (reduced, ninfo);
-      return reduced;
-    }
-
-  if ((lbt != FFEINFO_basictypeCHARACTER) && (rbt != FFEINFO_basictypeCHARACTER))
-    {
-      if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_CONCAT_ARGS_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (lbt != FFEINFO_basictypeCHARACTER)
-    {
-      if ((lbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_CONCAT_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (rbt != FFEINFO_basictypeCHARACTER)
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_CONCAT_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if ((lrk != 0) || (lszm == FFETARGET_charactersizeNONE))
-    {
-      if ((lkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_CONCAT_ARG_KIND))
-	{
-	  const char *what;
-
-	  if (lrk != 0)
-	    what = "an array";
-	  else
-	    what = "of indeterminate length";
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_string (what);
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if (ffebad_start (FFEBAD_CONCAT_ARG_KIND))
-	{
-	  const char *what;
-
-	  if (rrk != 0)
-	    what = "an array";
-	  else
-	    what = "of indeterminate length";
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string (what);
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_eqop2_ -- Wrap up reduction of EQ and NE operators
-
-   reduced = ffeexpr_reduced_eqop2_(reduced,l,op,r);
-
-   Makes sure the left and right arguments for reduced have basictype of
-   INTEGER, REAL, COMPLEX, or CHARACTER.  Determine common basictype and
-   size for reduction.	If both left
-   and right arguments have where of CONSTANT, assign where CONSTANT to
-   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
-   needed.  Convert typeless
-   constants to the desired type/size explicitly.
-
-   If these requirements cannot be met, generate error message.	 */
-
-static ffebld
-ffeexpr_reduced_eqop2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo, ninfo;
-  ffeinfoBasictype lbt, rbt, nbt;
-  ffeinfoKindtype lkt, rkt, nkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh, nwh;
-  ffetargetCharacterSize lsz, rsz;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-  lsz = ffebld_size_known (ffebld_left (reduced));
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-  rsz = ffebld_size_known (ffebld_right (reduced));
-
-  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
-
-  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
-       || (nbt == FFEINFO_basictypeCOMPLEX) || (nbt == FFEINFO_basictypeCHARACTER))
-      && (lrk == 0) && (rrk == 0))
-    {
-      switch (lwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      nwh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      if ((lsz != FFETARGET_charactersizeNONE)
-	  && (rsz != FFETARGET_charactersizeNONE))
-	lsz = rsz = (lsz > rsz) ? lsz : rsz;
-
-      ninfo = ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
-		   0, FFEINFO_kindENTITY, nwh, FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-				      l->token, op->token, nbt, nkt, 0, lsz,
-						 FFEEXPR_contextLET));
-      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-				      r->token, op->token, nbt, nkt, 0, rsz,
-						  FFEEXPR_contextLET));
-      return reduced;
-    }
-
-  if ((lbt == FFEINFO_basictypeLOGICAL)
-      && (rbt == FFEINFO_basictypeLOGICAL))
-    {
-      /* xgettext:no-c-format */
-      if (ffebad_start_msg ("Use .EQV./.NEQV. instead of .EQ./.NE. at %0 for LOGICAL operands at %1 and %2",
-			    FFEBAD_severityFATAL))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
-      && (lbt != FFEINFO_basictypeCOMPLEX) && (lbt != FFEINFO_basictypeCHARACTER))
-    {
-      if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-	  && (rbt != FFEINFO_basictypeCOMPLEX) && (rbt != FFEINFO_basictypeCHARACTER))
-	{
-	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_EQOP_ARGS_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	      ffebad_finish ();
-	    }
-	}
-      else
-	{
-	  if ((lbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_EQOP_ARG_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_finish ();
-	    }
-	}
-    }
-  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-	   && (rbt != FFEINFO_basictypeCOMPLEX) && (rbt != FFEINFO_basictypeCHARACTER))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_EQOP_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (lrk != 0)
-    {
-      if ((lkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_EQOP_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_EQOP_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_math1_ -- Wrap up reduction of + - unary operators
-
-   reduced = ffeexpr_reduced_math1_(reduced,op,r);
-
-   Makes sure the argument for reduced has basictype of
-   INTEGER, REAL, or COMPLEX.  If the argument has where of CONSTANT,
-   assign where CONSTANT to
-   reduced, else assign where FLEETING.
-
-   If these requirements cannot be met, generate error message.	 */
-
-static ffebld
-ffeexpr_reduced_math1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
-{
-  ffeinfo rinfo, ninfo;
-  ffeinfoBasictype rbt;
-  ffeinfoKindtype rkt;
-  ffeinfoRank rrk;
-  ffeinfoKind rkd;
-  ffeinfoWhere rwh, nwh;
-
-  rinfo = ffebld_info (ffebld_left (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if (((rbt == FFEINFO_basictypeINTEGER) || (rbt == FFEINFO_basictypeREAL)
-       || (rbt == FFEINFO_basictypeCOMPLEX)) && (rrk == 0))
-    {
-      switch (rwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  nwh = FFEINFO_whereCONSTANT;
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  nwh = FFEINFO_whereIMMEDIATE;
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      ninfo = ffeinfo_new (rbt, rkt, 0, FFEINFO_kindENTITY, nwh,
-			   FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      return reduced;
-    }
-
-  if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-      && (rbt != FFEINFO_basictypeCOMPLEX))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_math2_ -- Wrap up reduction of + - * / operators
-
-   reduced = ffeexpr_reduced_math2_(reduced,l,op,r);
-
-   Makes sure the left and right arguments for reduced have basictype of
-   INTEGER, REAL, or COMPLEX.  Determine common basictype and
-   size for reduction (flag expression for combined hollerith/typeless
-   situations for later determination of effective basictype).	If both left
-   and right arguments have where of CONSTANT, assign where CONSTANT to
-   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
-   needed.  Convert typeless
-   constants to the desired type/size explicitly.
-
-   If these requirements cannot be met, generate error message.	 */
-
-static ffebld
-ffeexpr_reduced_math2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo, ninfo;
-  ffeinfoBasictype lbt, rbt, nbt;
-  ffeinfoKindtype lkt, rkt, nkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh, nwh;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
-
-  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
-       || (nbt == FFEINFO_basictypeCOMPLEX)) && (lrk == 0) && (rrk == 0))
-    {
-      switch (lwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      nwh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
-			   FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-	      l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET));
-      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-	      r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
-						  FFEEXPR_contextLET));
-      return reduced;
-    }
-
-  if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
-      && (lbt != FFEINFO_basictypeCOMPLEX))
-    {
-      if ((rbt != FFEINFO_basictypeINTEGER)
-      && (rbt != FFEINFO_basictypeREAL) && (rbt != FFEINFO_basictypeCOMPLEX))
-	{
-	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_MATH_ARGS_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	      ffebad_finish ();
-	    }
-	}
-      else
-	{
-	  if ((lbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_MATH_ARG_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_finish ();
-	    }
-	}
-    }
-  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-	   && (rbt != FFEINFO_basictypeCOMPLEX))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (lrk != 0)
-    {
-      if ((lkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_power_ -- Wrap up reduction of ** operator
-
-   reduced = ffeexpr_reduced_power_(reduced,l,op,r);
-
-   Makes sure the left and right arguments for reduced have basictype of
-   INTEGER, REAL, or COMPLEX.  Determine common basictype and
-   size for reduction (flag expression for combined hollerith/typeless
-   situations for later determination of effective basictype).	If both left
-   and right arguments have where of CONSTANT, assign where CONSTANT to
-   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
-   needed.  Note that real**int or complex**int
-   comes out as int = real**int etc with no conversions.
-
-   If these requirements cannot be met, generate error message using the
-   info in l, op, and r arguments and assign basictype, size, kind, and where
-   of ANY.  */
-
-static ffebld
-ffeexpr_reduced_power_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo, ninfo;
-  ffeinfoBasictype lbt, rbt, nbt;
-  ffeinfoKindtype lkt, rkt, nkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh, nwh;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if ((rbt == FFEINFO_basictypeINTEGER)
-      && ((lbt == FFEINFO_basictypeREAL)
-	  || (lbt == FFEINFO_basictypeCOMPLEX)))
-    {
-      nbt = lbt;
-      nkt = ffeinfo_kindtype_max (nbt, lkt, FFEINFO_kindtypeREALDEFAULT);
-      if (nkt != FFEINFO_kindtypeREALDEFAULT)
-	{
-	  nkt = ffeinfo_kindtype_max (nbt, lkt, FFEINFO_kindtypeREALDOUBLE);
-	  if (nkt != FFEINFO_kindtypeREALDOUBLE)
-	    nkt = FFEINFO_kindtypeREALDOUBLE;	/* Highest kt we can power! */
-	}
-      if (rkt == FFEINFO_kindtypeINTEGER4)
-	{
-	  /* xgettext:no-c-format */
-	  ffebad_start_msg ("Unsupported operand for ** at %1 -- converting to default INTEGER",
-			    FFEBAD_severityWARNING);
-	  ffebad_here (0, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-      if (rkt != FFEINFO_kindtypeINTEGERDEFAULT)
-	{
-	  ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-						      r->token, op->token,
-		FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT, 0,
-						FFETARGET_charactersizeNONE,
-						      FFEEXPR_contextLET));
-	  rkt = FFEINFO_kindtypeINTEGERDEFAULT;
-	}
-    }
-  else
-    {
-      ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
-
-#if 0	/* INTEGER4**INTEGER4 works now. */
-      if ((nbt == FFEINFO_basictypeINTEGER)
-	  && (nkt != FFEINFO_kindtypeINTEGERDEFAULT))
-	nkt = FFEINFO_kindtypeINTEGERDEFAULT;	/* Highest kt we can power! */
-#endif
-      if (((nbt == FFEINFO_basictypeREAL)
-	   || (nbt == FFEINFO_basictypeCOMPLEX))
-	  && (nkt != FFEINFO_kindtypeREALDEFAULT))
-	{
-	  nkt = ffeinfo_kindtype_max (nbt, nkt, FFEINFO_kindtypeREALDOUBLE);
-	  if (nkt != FFEINFO_kindtypeREALDOUBLE)
-	    nkt = FFEINFO_kindtypeREALDOUBLE;	/* Highest kt we can power! */
-	}
-      /* else Gonna turn into an error below. */
-    }
-
-  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
-       || (nbt == FFEINFO_basictypeCOMPLEX)) && (lrk == 0) && (rrk == 0))
-    {
-      switch (lwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      nwh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      ninfo = ffeinfo_new (nbt, nkt, 0, FFEINFO_kindENTITY, nwh,
-			   FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-	      l->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET));
-      if (rbt != FFEINFO_basictypeINTEGER)
-	ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-	      r->token, op->token, nbt, nkt, 0, FFETARGET_charactersizeNONE,
-						    FFEEXPR_contextLET));
-      return reduced;
-    }
-
-  if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
-      && (lbt != FFEINFO_basictypeCOMPLEX))
-    {
-      if ((rbt != FFEINFO_basictypeINTEGER)
-      && (rbt != FFEINFO_basictypeREAL) && (rbt != FFEINFO_basictypeCOMPLEX))
-	{
-	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_MATH_ARGS_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	      ffebad_finish ();
-	    }
-	}
-      else
-	{
-	  if ((lbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_MATH_ARG_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_finish ();
-	    }
-	}
-    }
-  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-	   && (rbt != FFEINFO_basictypeCOMPLEX))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (lrk != 0)
-    {
-      if ((lkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_MATH_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_relop2_ -- Wrap up reduction of LT, LE, GE, and GT operators
-
-   reduced = ffeexpr_reduced_relop2_(reduced,l,op,r);
-
-   Makes sure the left and right arguments for reduced have basictype of
-   INTEGER, REAL, or CHARACTER.	 Determine common basictype and
-   size for reduction.	If both left
-   and right arguments have where of CONSTANT, assign where CONSTANT to
-   reduced, else assign where FLEETING.	 Create CONVERT ops for args where
-   needed.  Convert typeless
-   constants to the desired type/size explicitly.
-
-   If these requirements cannot be met, generate error message.	 */
-
-static ffebld
-ffeexpr_reduced_relop2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			 ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo, ninfo;
-  ffeinfoBasictype lbt, rbt, nbt;
-  ffeinfoKindtype lkt, rkt, nkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh, nwh;
-  ffetargetCharacterSize lsz, rsz;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-  lsz = ffebld_size_known (ffebld_left (reduced));
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-  rsz = ffebld_size_known (ffebld_right (reduced));
-
-  ffeexpr_type_combine (&nbt, &nkt, lbt, lkt, rbt, rkt, op->token);
-
-  if (((nbt == FFEINFO_basictypeINTEGER) || (nbt == FFEINFO_basictypeREAL)
-       || (nbt == FFEINFO_basictypeCHARACTER))
-      && (lrk == 0) && (rrk == 0))
-    {
-      switch (lwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      nwh = FFEINFO_whereCONSTANT;
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  switch (rwh)
-	    {
-	    case FFEINFO_whereCONSTANT:
-	    case FFEINFO_whereIMMEDIATE:
-	      nwh = FFEINFO_whereIMMEDIATE;
-	      break;
-
-	    default:
-	      nwh = FFEINFO_whereFLEETING;
-	      break;
-	    }
-	  break;
-
-	default:
-	  nwh = FFEINFO_whereFLEETING;
-	  break;
-	}
-
-      if ((lsz != FFETARGET_charactersizeNONE)
-	  && (rsz != FFETARGET_charactersizeNONE))
-	lsz = rsz = (lsz > rsz) ? lsz : rsz;
-
-      ninfo = ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
-		   0, FFEINFO_kindENTITY, nwh, FFETARGET_charactersizeNONE);
-      ffebld_set_info (reduced, ninfo);
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-				      l->token, op->token, nbt, nkt, 0, lsz,
-						 FFEEXPR_contextLET));
-      ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-				      r->token, op->token, nbt, nkt, 0, rsz,
-						  FFEEXPR_contextLET));
-      return reduced;
-    }
-
-  if ((lbt != FFEINFO_basictypeINTEGER) && (lbt != FFEINFO_basictypeREAL)
-      && (lbt != FFEINFO_basictypeCHARACTER))
-    {
-      if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-	  && (rbt != FFEINFO_basictypeCHARACTER))
-	{
-	  if ((lbt != FFEINFO_basictypeANY) && (rbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_RELOP_ARGS_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_here (2, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	      ffebad_finish ();
-	    }
-	}
-      else
-	{
-	  if ((lbt != FFEINFO_basictypeANY)
-	      && ffebad_start (FFEBAD_RELOP_ARG_TYPE))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	      ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	      ffebad_finish ();
-	    }
-	}
-    }
-  else if ((rbt != FFEINFO_basictypeINTEGER) && (rbt != FFEINFO_basictypeREAL)
-	   && (rbt != FFEINFO_basictypeCHARACTER))
-    {
-      if ((rbt != FFEINFO_basictypeANY)
-	  && ffebad_start (FFEBAD_RELOP_ARG_TYPE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_finish ();
-	}
-    }
-  else if (lrk != 0)
-    {
-      if ((lkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_RELOP_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (l->token), ffelex_token_where_column (l->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if ((rkd != FFEINFO_kindANY)
-	  && ffebad_start (FFEBAD_RELOP_ARG_KIND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (op->token), ffelex_token_where_column (op->token));
-	  ffebad_here (1, ffelex_token_where_line (r->token), ffelex_token_where_column (r->token));
-	  ffebad_string ("an array");
-	  ffebad_finish ();
-	}
-    }
-
-  reduced = ffebld_new_any ();
-  ffebld_set_info (reduced, ffeinfo_new_any ());
-  return reduced;
-}
-
-/* ffeexpr_reduced_ugly1_ -- Deal with TYPELESS, HOLLERITH, and LOGICAL
-
-   reduced = ffeexpr_reduced_ugly1_(reduced,op,r);
-
-   Sigh.  */
-
-static ffebld
-ffeexpr_reduced_ugly1_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
-{
-  ffeinfo rinfo;
-  ffeinfoBasictype rbt;
-  ffeinfoKindtype rkt;
-  ffeinfoRank rrk;
-  ffeinfoKind rkd;
-  ffeinfoWhere rwh;
-
-  rinfo = ffebld_info (ffebld_left (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if ((rbt == FFEINFO_basictypeTYPELESS)
-      || (rbt == FFEINFO_basictypeHOLLERITH))
-    {
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-			      r->token, op->token, FFEINFO_basictypeINTEGER,
-					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
-						 FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET));
-      rinfo = ffebld_info (ffebld_left (reduced));
-      rbt = FFEINFO_basictypeINTEGER;
-      rkt = FFEINFO_kindtypeINTEGERDEFAULT;
-      rrk = 0;
-      rkd = FFEINFO_kindENTITY;
-      rwh = ffeinfo_where (rinfo);
-    }
-
-  if (rbt == FFEINFO_basictypeLOGICAL)
-    {
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-			      r->token, op->token, FFEINFO_basictypeINTEGER,
-					  FFEINFO_kindtypeINTEGERDEFAULT, 0,
-						 FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET));
-    }
-
-  return reduced;
-}
-
-/* ffeexpr_reduced_ugly1log_ -- Deal with TYPELESS and HOLLERITH
-
-   reduced = ffeexpr_reduced_ugly1log_(reduced,op,r);
-
-   Sigh.  */
-
-static ffebld
-ffeexpr_reduced_ugly1log_ (ffebld reduced, ffeexprExpr_ op, ffeexprExpr_ r)
-{
-  ffeinfo rinfo;
-  ffeinfoBasictype rbt;
-  ffeinfoKindtype rkt;
-  ffeinfoRank rrk;
-  ffeinfoKind rkd;
-  ffeinfoWhere rwh;
-
-  rinfo = ffebld_info (ffebld_left (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if ((rbt == FFEINFO_basictypeTYPELESS)
-      || (rbt == FFEINFO_basictypeHOLLERITH))
-    {
-      ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-			   r->token, op->token, FFEINFO_basictypeLOGICAL, 0,
-					     FFEINFO_kindtypeLOGICALDEFAULT,
-						 FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET));
-      rinfo = ffebld_info (ffebld_left (reduced));
-      rbt = FFEINFO_basictypeLOGICAL;
-      rkt = FFEINFO_kindtypeLOGICALDEFAULT;
-      rrk = 0;
-      rkd = FFEINFO_kindENTITY;
-      rwh = ffeinfo_where (rinfo);
-    }
-
-  return reduced;
-}
-
-/* ffeexpr_reduced_ugly2_ -- Deal with TYPELESS, HOLLERITH, and LOGICAL
-
-   reduced = ffeexpr_reduced_ugly2_(reduced,l,op,r);
-
-   Sigh.  */
-
-static ffebld
-ffeexpr_reduced_ugly2_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			ffeexprExpr_ r)
-{
-  ffeinfo linfo, rinfo;
-  ffeinfoBasictype lbt, rbt;
-  ffeinfoKindtype lkt, rkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if ((lbt == FFEINFO_basictypeTYPELESS)
-      || (lbt == FFEINFO_basictypeHOLLERITH))
-    {
-      if ((rbt == FFEINFO_basictypeTYPELESS)
-	  || (rbt == FFEINFO_basictypeHOLLERITH))
-	{
-	  ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-			      l->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, 0,
-					     FFEINFO_kindtypeINTEGERDEFAULT,
-						FFETARGET_charactersizeNONE,
-						      FFEEXPR_contextLET));
-	  linfo = ffebld_info (ffebld_left (reduced));
-	  rinfo = ffebld_info (ffebld_right (reduced));
-	  lbt = rbt = FFEINFO_basictypeINTEGER;
-	  lkt = rkt = FFEINFO_kindtypeINTEGERDEFAULT;
-	  lrk = rrk = 0;
-	  lkd = rkd = FFEINFO_kindENTITY;
-	  lwh = ffeinfo_where (linfo);
-	  rwh = ffeinfo_where (rinfo);
-	}
-      else
-	{
-	  ffebld_set_left (reduced, ffeexpr_convert_expr (ffebld_left (reduced),
-				 l->token, ffebld_right (reduced), r->token,
-						       FFEEXPR_contextLET));
-	  linfo = ffebld_info (ffebld_left (reduced));
-	  lbt = ffeinfo_basictype (linfo);
-	  lkt = ffeinfo_kindtype (linfo);
-	  lrk = ffeinfo_rank (linfo);
-	  lkd = ffeinfo_kind (linfo);
-	  lwh = ffeinfo_where (linfo);
-	}
-    }
-  else
-    {
-      if ((rbt == FFEINFO_basictypeTYPELESS)
-	  || (rbt == FFEINFO_basictypeHOLLERITH))
-	{
-	  ffebld_set_right (reduced, ffeexpr_convert_expr (ffebld_right (reduced),
-				  r->token, ffebld_left (reduced), l->token,
-						       FFEEXPR_contextLET));
-	  rinfo = ffebld_info (ffebld_right (reduced));
-	  rbt = ffeinfo_basictype (rinfo);
-	  rkt = ffeinfo_kindtype (rinfo);
-	  rrk = ffeinfo_rank (rinfo);
-	  rkd = ffeinfo_kind (rinfo);
-	  rwh = ffeinfo_where (rinfo);
-	}
-      /* else Leave it alone. */
-    }
-
-  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));
-    }
-
-  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));
-    }
-
-  return reduced;
-}
-
-/* ffeexpr_reduced_ugly2log_ -- Deal with TYPELESS and HOLLERITH
-
-   reduced = ffeexpr_reduced_ugly2log_(reduced,l,op,r);
-
-   Sigh.  */
-
-static ffebld
-ffeexpr_reduced_ugly2log_ (ffebld reduced, ffeexprExpr_ l, ffeexprExpr_ op,
-			   ffeexprExpr_ r, bool *bothlogical)
-{
-  ffeinfo linfo, rinfo;
-  ffeinfoBasictype lbt, rbt;
-  ffeinfoKindtype lkt, rkt;
-  ffeinfoRank lrk, rrk;
-  ffeinfoKind lkd, rkd;
-  ffeinfoWhere lwh, rwh;
-
-  linfo = ffebld_info (ffebld_left (reduced));
-  lbt = ffeinfo_basictype (linfo);
-  lkt = ffeinfo_kindtype (linfo);
-  lrk = ffeinfo_rank (linfo);
-  lkd = ffeinfo_kind (linfo);
-  lwh = ffeinfo_where (linfo);
-
-  rinfo = ffebld_info (ffebld_right (reduced));
-  rbt = ffeinfo_basictype (rinfo);
-  rkt = ffeinfo_kindtype (rinfo);
-  rrk = ffeinfo_rank (rinfo);
-  rkd = ffeinfo_kind (rinfo);
-  rwh = ffeinfo_where (rinfo);
-
-  if ((lbt == FFEINFO_basictypeTYPELESS)
-      || (lbt == FFEINFO_basictypeHOLLERITH))
-    {
-      if ((rbt == FFEINFO_basictypeTYPELESS)
-	  || (rbt == FFEINFO_basictypeHOLLERITH))
-	{
-	  ffebld_set_left (reduced, ffeexpr_convert (ffebld_left (reduced),
-			      l->token, op->token, FFEINFO_basictypeLOGICAL,
-					  FFEINFO_kindtypeLOGICALDEFAULT, 0,
-						FFETARGET_charactersizeNONE,
-						     FFEEXPR_contextLET));
-	  ffebld_set_right (reduced, ffeexpr_convert (ffebld_right (reduced),
-			      r->token, op->token, FFEINFO_basictypeLOGICAL,
-					  FFEINFO_kindtypeLOGICALDEFAULT, 0,
-						FFETARGET_charactersizeNONE,
-						      FFEEXPR_contextLET));
-	  linfo = ffebld_info (ffebld_left (reduced));
-	  rinfo = ffebld_info (ffebld_right (reduced));
-	  lbt = rbt = FFEINFO_basictypeLOGICAL;
-	  lkt = rkt = FFEINFO_kindtypeLOGICALDEFAULT;
-	  lrk = rrk = 0;
-	  lkd = rkd = FFEINFO_kindENTITY;
-	  lwh = ffeinfo_where (linfo);
-	  rwh = ffeinfo_where (rinfo);
-	}
-      else
-	{
-	  ffebld_set_left (reduced, ffeexpr_convert_expr (ffebld_left (reduced),
-				 l->token, ffebld_right (reduced), r->token,
-						       FFEEXPR_contextLET));
-	  linfo = ffebld_info (ffebld_left (reduced));
-	  lbt = ffeinfo_basictype (linfo);
-	  lkt = ffeinfo_kindtype (linfo);
-	  lrk = ffeinfo_rank (linfo);
-	  lkd = ffeinfo_kind (linfo);
-	  lwh = ffeinfo_where (linfo);
-	}
-    }
-  else
-    {
-      if ((rbt == FFEINFO_basictypeTYPELESS)
-	  || (rbt == FFEINFO_basictypeHOLLERITH))
-	{
-	  ffebld_set_right (reduced, ffeexpr_convert_expr (ffebld_right (reduced),
-				  r->token, ffebld_left (reduced), l->token,
-						       FFEEXPR_contextLET));
-	  rinfo = ffebld_info (ffebld_right (reduced));
-	  rbt = ffeinfo_basictype (rinfo);
-	  rkt = ffeinfo_kindtype (rinfo);
-	  rrk = ffeinfo_rank (rinfo);
-	  rkd = ffeinfo_kind (rinfo);
-	  rwh = ffeinfo_where (rinfo);
-	}
-      /* else Leave it alone. */
-    }
-
-  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));
-    }
-
-  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));
-    }
-
-  if (bothlogical != NULL)
-    *bothlogical = (lbt == FFEINFO_basictypeLOGICAL
-		    && rbt == FFEINFO_basictypeLOGICAL);
-
-  return reduced;
-}
-
-/* Fumble through tokens until a nonmatching CLOSE_PAREN, EOS, or SEMICOLON
-   is found.
-
-   The idea is to process the tokens as they would be done by normal
-   expression processing, with the key things being telling the lexer
-   when hollerith/character constants are about to happen, until the
-   true closing token is found.  */
-
-static ffelexHandler
-ffeexpr_find_close_paren_ (ffelexToken t,
-			   ffelexHandler after)
-{
-  ffeexpr_find_.after = after;
-  ffeexpr_find_.level = 1;
-  return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-}
-
-static ffelexHandler
-ffeexpr_nil_finished_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (--ffeexpr_find_.level == 0)
-	return (ffelexHandler) ffeexpr_find_.after;
-      return (ffelexHandler) ffeexpr_nil_binary_;
-
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLON:
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    default:
-      if (--ffeexpr_find_.level == 0)
-	return (ffelexHandler) ffeexpr_find_.after (t);
-      return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_rhs_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeQUOTE:
-      if (ffe_is_vxt ())
-	return (ffelexHandler) ffeexpr_nil_quote_;
-      ffelex_set_expecting_hollerith (-1, '\"',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));
-      return (ffelexHandler) ffeexpr_nil_apostrophe_;
-
-    case FFELEX_typeAPOSTROPHE:
-      ffelex_set_expecting_hollerith (-1, '\'',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));
-      return (ffelexHandler) ffeexpr_nil_apostrophe_;
-
-    case FFELEX_typePERCENT:
-      return (ffelexHandler) ffeexpr_nil_percent_;
-
-    case FFELEX_typeOPEN_PAREN:
-      ++ffeexpr_find_.level;
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    case FFELEX_typePLUS:
-    case FFELEX_typeMINUS:
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    case FFELEX_typePERIOD:
-      return (ffelexHandler) ffeexpr_nil_period_;
-
-    case FFELEX_typeNUMBER:
-      ffeexpr_hollerith_count_ = atol (ffelex_token_text (t));
-      if (ffeexpr_hollerith_count_ > 0)
-	ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_,
-					'\0',
-					ffelex_token_where_line (t),
-					ffelex_token_where_column (t));
-      return (ffelexHandler) ffeexpr_nil_number_;
-
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      return (ffelexHandler) ffeexpr_nil_name_rhs_;
-
-    case FFELEX_typeASTERISK:
-    case FFELEX_typeSLASH:
-    case FFELEX_typePOWER:
-    case FFELEX_typeCONCAT:
-    case FFELEX_typeREL_EQ:
-    case FFELEX_typeREL_NE:
-    case FFELEX_typeREL_LE:
-    case FFELEX_typeREL_GE:
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_finished_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_period_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_current_dotdot_ = ffestr_other (t);
-      switch (ffeexpr_current_dotdot_)
-	{
-	case FFESTR_otherNone:
-	  return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-
-	case FFESTR_otherTRUE:
-	case FFESTR_otherFALSE:
-	case FFESTR_otherNOT:
-	  return (ffelexHandler) ffeexpr_nil_end_period_;
-
-	default:
-	  return (ffelexHandler) ffeexpr_nil_swallow_period_;
-	}
-      break;			/* Nothing really reaches here. */
-
-    case FFELEX_typeNUMBER:
-      return (ffelexHandler) ffeexpr_nil_real_;
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_end_period_ (ffelexToken t)
-{
-  switch (ffeexpr_current_dotdot_)
-    {
-    case FFESTR_otherNOT:
-      if (ffelex_token_type (t) != FFELEX_typePERIOD)
-	return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    case FFESTR_otherTRUE:
-    case FFESTR_otherFALSE:
-      if (ffelex_token_type (t) != FFELEX_typePERIOD)
-	return (ffelexHandler) ffeexpr_nil_binary_ (t);
-      return (ffelexHandler) ffeexpr_nil_binary_;
-
-    default:
-      assert ("Bad [nil] unary dotdot in ffeexpr_current_dotdot_" == NULL);
-      exit (0);
-      return NULL;
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_swallow_period_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-  return (ffelexHandler) ffeexpr_nil_rhs_;
-}
-
-static ffelexHandler
-ffeexpr_nil_real_ (ffelexToken t)
-{
-  char d;
-  const char *p;
-
-  if (((ffelex_token_type (t) != FFELEX_typeNAME)
-       && (ffelex_token_type (t) != FFELEX_typeNAMES))
-      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				     'D', 'd')
-	     || ffesrc_char_match_init (d, 'E', 'e')
-	     || ffesrc_char_match_init (d, 'Q', 'q')))
-	   && ffeexpr_isdigits_ (++p)))
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-
-  if (*p == '\0')
-    return (ffelexHandler) ffeexpr_nil_real_exponent_;
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_real_exponent_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-
-  return (ffelexHandler) ffeexpr_nil_real_exp_sign_;
-}
-
-static ffelexHandler
-ffeexpr_nil_real_exp_sign_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_number_ (ffelexToken t)
-{
-  char d;
-  const char *p;
-
-  if (ffeexpr_hollerith_count_ > 0)
-    ffelex_set_expecting_hollerith (0, '\0',
-				    ffewhere_line_unknown (),
-				    ffewhere_column_unknown ());
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				   'D', 'd')
-	   || ffesrc_char_match_init (d, 'E', 'e')
-	   || ffesrc_char_match_init (d, 'Q', 'q'))
-	  && ffeexpr_isdigits_ (++p))
-	{
-	  if (*p == '\0')
-	    {
-	      ffeexpr_find_.t = ffelex_token_use (t);
-	      return (ffelexHandler) ffeexpr_nil_number_exponent_;
-	    }
-	  return (ffelexHandler) ffeexpr_nil_binary_;
-	}
-      break;
-
-    case FFELEX_typePERIOD:
-      ffeexpr_find_.t = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_nil_number_period_;
-
-    case FFELEX_typeHOLLERITH:
-      return (ffelexHandler) ffeexpr_nil_binary_;
-
-    default:
-      break;
-    }
-  return (ffelexHandler) ffeexpr_nil_binary_ (t);
-}
-
-/* Expects ffeexpr_find_.t.  */
-
-static ffelexHandler
-ffeexpr_nil_number_exponent_ (ffelexToken t)
-{
-  ffelexHandler nexthandler;
-
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    {
-      nexthandler
-	= (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
-      ffelex_token_kill (ffeexpr_find_.t);
-      return (ffelexHandler) (*nexthandler) (t);
-    }
-
-  ffelex_token_kill (ffeexpr_find_.t);
-  return (ffelexHandler) ffeexpr_nil_number_exp_sign_;
-}
-
-static ffelexHandler
-ffeexpr_nil_number_exp_sign_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-/* Expects ffeexpr_find_.t.  */
-
-static ffelexHandler
-ffeexpr_nil_number_period_ (ffelexToken t)
-{
-  ffelexHandler nexthandler;
-  char d;
-  const char *p;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				   'D', 'd')
-	   || ffesrc_char_match_init (d, 'E', 'e')
-	   || ffesrc_char_match_init (d, 'Q', 'q'))
-	  && ffeexpr_isdigits_ (++p))
-	{
-	  if (*p == '\0')
-	    return (ffelexHandler) ffeexpr_nil_number_per_exp_;
-	  ffelex_token_kill (ffeexpr_find_.t);
-	  return (ffelexHandler) ffeexpr_nil_binary_;
-	}
-      nexthandler
-	= (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
-      ffelex_token_kill (ffeexpr_find_.t);
-      return (ffelexHandler) (*nexthandler) (t);
-
-    case FFELEX_typeNUMBER:
-      ffelex_token_kill (ffeexpr_find_.t);
-      return (ffelexHandler) ffeexpr_nil_number_real_;
-
-    default:
-      break;
-    }
-  ffelex_token_kill (ffeexpr_find_.t);
-  return (ffelexHandler) ffeexpr_nil_binary_ (t);
-}
-
-/* Expects ffeexpr_find_.t.  */
-
-static ffelexHandler
-ffeexpr_nil_number_per_exp_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    {
-      ffelexHandler nexthandler;
-
-      nexthandler
-	= (ffelexHandler) ffeexpr_nil_binary_ (ffeexpr_find_.t);
-      ffelex_token_kill (ffeexpr_find_.t);
-      return (ffelexHandler) (*nexthandler) (t);
-    }
-
-  ffelex_token_kill (ffeexpr_find_.t);
-  return (ffelexHandler) ffeexpr_nil_num_per_exp_sign_;
-}
-
-static ffelexHandler
-ffeexpr_nil_number_real_ (ffelexToken t)
-{
-  char d;
-  const char *p;
-
-  if (((ffelex_token_type (t) != FFELEX_typeNAME)
-       && (ffelex_token_type (t) != FFELEX_typeNAMES))
-      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				     'D', 'd')
-	     || ffesrc_char_match_init (d, 'E', 'e')
-	     || ffesrc_char_match_init (d, 'Q', 'q')))
-	   && ffeexpr_isdigits_ (++p)))
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-
-  if (*p == '\0')
-    return (ffelexHandler) ffeexpr_nil_number_real_exp_;
-
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_num_per_exp_sign_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_number_real_exp_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-  return (ffelexHandler) ffeexpr_nil_num_real_exp_sn_;
-}
-
-static ffelexHandler
-ffeexpr_nil_num_real_exp_sn_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_binary_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typePLUS:
-    case FFELEX_typeMINUS:
-    case FFELEX_typeASTERISK:
-    case FFELEX_typeSLASH:
-    case FFELEX_typePOWER:
-    case FFELEX_typeCONCAT:
-    case FFELEX_typeOPEN_ANGLE:
-    case FFELEX_typeCLOSE_ANGLE:
-    case FFELEX_typeREL_EQ:
-    case FFELEX_typeREL_NE:
-    case FFELEX_typeREL_GE:
-    case FFELEX_typeREL_LE:
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    case FFELEX_typePERIOD:
-      return (ffelexHandler) ffeexpr_nil_binary_period_;
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_finished_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_binary_period_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_current_dotdot_ = ffestr_other (t);
-      switch (ffeexpr_current_dotdot_)
-	{
-	case FFESTR_otherTRUE:
-	case FFESTR_otherFALSE:
-	case FFESTR_otherNOT:
-	  return (ffelexHandler) ffeexpr_nil_binary_sw_per_;
-
-	default:
-	  return (ffelexHandler) ffeexpr_nil_binary_end_per_;
-	}
-      break;			/* Nothing really reaches here. */
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_binary_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_binary_end_per_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-  return (ffelexHandler) ffeexpr_nil_rhs_;
-}
-
-static ffelexHandler
-ffeexpr_nil_binary_sw_per_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_quote_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-  return (ffelexHandler) ffeexpr_nil_binary_;
-}
-
-static ffelexHandler
-ffeexpr_nil_apostrophe_ (ffelexToken t)
-{
-  assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
-  return (ffelexHandler) ffeexpr_nil_apos_char_;
-}
-
-static ffelexHandler
-ffeexpr_nil_apos_char_ (ffelexToken t)
-{
-  char c;
-
-  if ((ffelex_token_type (t) == FFELEX_typeNAME)
-      || (ffelex_token_type (t) == FFELEX_typeNAMES))
-    {
-      if ((ffelex_token_length (t) == 1)
-	  && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]),
-				      'B', 'b')
-	      || ffesrc_char_match_init (c, 'O', 'o')
-	      || ffesrc_char_match_init (c, 'X', 'x')
-	      || ffesrc_char_match_init (c, 'Z', 'z')))
-	return (ffelexHandler) ffeexpr_nil_binary_;
-    }
-  if ((ffelex_token_type (t) == FFELEX_typeNAME)
-      || (ffelex_token_type (t) == FFELEX_typeNAMES))
-    return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-  return (ffelexHandler) ffeexpr_nil_substrp_ (t);
-}
-
-static ffelexHandler
-ffeexpr_nil_name_rhs_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeQUOTE:
-    case FFELEX_typeAPOSTROPHE:
-      ffelex_set_hexnum (TRUE);
-      return (ffelexHandler) ffeexpr_nil_name_apos_;
-
-    case FFELEX_typeOPEN_PAREN:
-      ++ffeexpr_find_.level;
-      return (ffelexHandler) ffeexpr_nil_rhs_;
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_binary_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_name_apos_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) == FFELEX_typeNAME)
-    return (ffelexHandler) ffeexpr_nil_name_apos_name_;
-  return (ffelexHandler) ffeexpr_nil_binary_ (t);
-}
-
-static ffelexHandler
-ffeexpr_nil_name_apos_name_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeAPOSTROPHE:
-    case FFELEX_typeQUOTE:
-      return (ffelexHandler) ffeexpr_nil_finished_;
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_finished_ (t);
-    }
-}
-
-static ffelexHandler
-ffeexpr_nil_percent_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_stack_->percent = ffeexpr_percent_ (t);
-      ffeexpr_find_.t = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_nil_percent_name_;
-
-    default:
-      return (ffelexHandler) ffeexpr_nil_rhs_ (t);
-    }
-}
-
-/* Expects ffeexpr_find_.t.  */
-
-static ffelexHandler
-ffeexpr_nil_percent_name_ (ffelexToken t)
-{
-  ffelexHandler nexthandler;
-
-  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
-    {
-      nexthandler
-	= (ffelexHandler) ffeexpr_nil_rhs_ (ffeexpr_find_.t);
-      ffelex_token_kill (ffeexpr_find_.t);
-      return (ffelexHandler) (*nexthandler) (t);
-    }
-
-  ffelex_token_kill (ffeexpr_find_.t);
-  ++ffeexpr_find_.level;
-  return (ffelexHandler) ffeexpr_nil_rhs_;
-}
-
-static ffelexHandler
-ffeexpr_nil_substrp_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
-    return (ffelexHandler) ffeexpr_nil_binary_ (t);
-
-  ++ffeexpr_find_.level;
-  return (ffelexHandler) ffeexpr_nil_rhs_;
-}
-
-/* ffeexpr_finished_ -- Reduce expression stack to one expr, finish
-
-   ffelexToken t;
-   return ffeexpr_finished_(t);
-
-   Reduces expression stack to one (or zero) elements by repeatedly reducing
-   the top operator on the stack (or, if the top element on the stack is
-   itself an operator, issuing an error message and discarding it).  Calls
-   finishing routine with the expression, returning the ffelexHandler it
-   returns to the caller.  */
-
-static ffelexHandler
-ffeexpr_finished_ (ffelexToken t)
-{
-  ffeexprExpr_ operand;		/* This is B in -B or A+B. */
-  ffebld expr;
-  ffeexprCallback callback;
-  ffeexprStack_ s;
-  ffebldConstant constnode;	/* For detecting magical number. */
-  ffelexToken ft;		/* Temporary copy of first token in
-				   expression. */
-  ffelexHandler next;
-  ffeinfo info;
-  bool error = FALSE;
-
-  while (((operand = ffeexpr_stack_->exprstack) != NULL)
-	 && ((operand->previous != NULL) || (operand->type != FFEEXPR_exprtypeOPERAND_)))
-    {
-      if (operand->type == FFEEXPR_exprtypeOPERAND_)
-	ffeexpr_reduce_ ();
-      else
-	{
-	  if (ffest_ffebad_start (FFEBAD_MISSING_OPERAND_FOR_OPERATOR))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
-	      ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
-	      ffebad_finish ();
-	    }
-	  ffeexpr_stack_->exprstack = operand->previous;	/* Pop the useless
-								   operator. */
-	  ffeexpr_expr_kill_ (operand);
-	}
-    }
-
-  assert ((operand == NULL) || (operand->previous == NULL));
-
-  ffebld_pool_pop ();
-  if (operand == NULL)
-    expr = NULL;
-  else
-    {
-      expr = operand->u.operand;
-      info = ffebld_info (expr);
-      if ((ffebld_op (expr) == FFEBLD_opCONTER)
-	  && (ffebld_conter_orig (expr) == NULL)
-	  && ffebld_constant_is_magical (constnode = ffebld_conter (expr)))
-	{
-	  ffetarget_integer_bad_magical (operand->token);
-	}
-      ffeexpr_expr_kill_ (operand);
-      ffeexpr_stack_->exprstack = NULL;
-    }
-
-  ft = ffeexpr_stack_->first_token;
-
-again:				/* :::::::::::::::::::: */
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextLET:
-    case FFEEXPR_contextSFUNCDEF:
-      error = (expr == NULL)
-	|| (ffeinfo_rank (info) != 0);
-      break;
-
-    case FFEEXPR_contextPAREN_:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextPARENFILENUM_:
-      if (ffelex_token_type (t) != FFELEX_typeCOMMA)
-	ffeexpr_stack_->context = FFEEXPR_contextPAREN_;
-      else
-	ffeexpr_stack_->context = FFEEXPR_contextFILENUM;
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEEXPR_contextPARENFILEUNIT_:
-      if (ffelex_token_type (t) != FFELEX_typeCOMMA)
-	ffeexpr_stack_->context = FFEEXPR_contextPAREN_;
-      else
-	ffeexpr_stack_->context = FFEEXPR_contextFILEUNIT;
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEEXPR_contextACTUALARGEXPR_:
-    case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  if (!ffe_is_ugly_args ()
-	      && ffebad_start (FFEBAD_ACTUALARG))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (ft),
-			   ffelex_token_where_column (ft));
-	      ffebad_finish ();
-	    }
-	  break;
-
-	default:
-	  break;
-	}
-      error = (expr != NULL) && (ffeinfo_rank (info) != 0);
-      break;
-
-    case FFEEXPR_contextACTUALARG_:
-    case FFEEXPR_contextSFUNCDEFACTUALARG_:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-#if 0				/* Should never get here. */
-	  expr = ffeexpr_convert (expr, ft, ft,
-				  FFEINFO_basictypeINTEGER,
-				  FFEINFO_kindtypeINTEGERDEFAULT,
-				  0,
-				  FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-#else
-	  assert ("why hollerith/typeless in actualarg_?" == NULL);
-#endif
-	  break;
-
-	default:
-	  break;
-	}
-      switch ((expr == NULL) ? FFEBLD_opANY : ffebld_op (expr))
-	{
-	case FFEBLD_opSYMTER:
-	case FFEBLD_opPERCENT_LOC:
-	case FFEBLD_opPERCENT_VAL:
-	case FFEBLD_opPERCENT_REF:
-	case FFEBLD_opPERCENT_DESCR:
-	  error = FALSE;
-	  break;
-
-	default:
-	  error = (expr != NULL) && (ffeinfo_rank (info) != 0);
-	  break;
-	}
-      {
-	ffesymbol s;
-	ffeinfoWhere where;
-	ffeinfoKind kind;
-
-	if (!error
-	    && (expr != NULL)
-	    && (ffebld_op (expr) == FFEBLD_opSYMTER)
-	    && ((s = ffebld_symter (expr)), (where = ffesymbol_where (s)),
-		(where == FFEINFO_whereINTRINSIC)
-		|| (where == FFEINFO_whereGLOBAL)
-		|| ((where == FFEINFO_whereDUMMY)
-		    && ((kind = ffesymbol_kind (s)),
-			(kind == FFEINFO_kindFUNCTION)
-			|| (kind == FFEINFO_kindSUBROUTINE))))
-	    && !ffesymbol_explicitwhere (s))
-	  {
-	    ffebad_start (where == FFEINFO_whereINTRINSIC
-			  ? FFEBAD_NEED_INTRINSIC : FFEBAD_NEED_EXTERNAL);
-	    ffebad_here (0, ffelex_token_where_line (ft),
-			 ffelex_token_where_column (ft));
-	    ffebad_string (ffesymbol_text (s));
-	    ffebad_finish ();
-	    ffesymbol_signal_change (s);
-	    ffesymbol_set_explicitwhere (s, TRUE);
-	    ffesymbol_signal_unreported (s);
-	  }
-      }
-      break;
-
-    case FFEEXPR_contextINDEX_:
-    case FFEEXPR_contextSFUNCDEFINDEX_:
-      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
-	break;
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeNONE:
-	  error = FALSE;
-	  break;
-
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeINTEGER:
-	  /* Specifically, allow INTEGER(KIND=2), aka INTEGER*8, through
-	     unmolested.  Leave it to downstream to handle kinds.  */
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;			/* expr==NULL ok for substring; element case
-				   caught by callback. */
-
-    case FFEEXPR_contextRETURN:
-      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
-	break;
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeNONE:
-	  error = FALSE;
-	  break;
-
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextDO:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  error = !ffe_is_ugly_logint ();
-	  if (!ffeexpr_stack_->is_rhs)
-	    break;		/* Don't convert lhs variable. */
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-				  ffeinfo_kindtype (ffebld_info (expr)), 0,
-				  FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  if (!ffeexpr_stack_->is_rhs)
-	    {
-	      error = TRUE;
-	      break;		/* Don't convert lhs variable. */
-	    }
-	  break;
-
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeREAL:
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if (!ffeexpr_stack_->is_rhs
-	  && (ffebld_op (expr) != FFEBLD_opSYMTER))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextDOWHILE:
-    case FFEEXPR_contextIF:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeLOGICAL:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextASSIGN:
-    case FFEEXPR_contextAGOTO:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  error = (ffeinfo_kindtype (info) != ffecom_label_kind ());
-	  break;
-
-	case FFEINFO_basictypeLOGICAL:
-	  error = !ffe_is_ugly_logint ()
-	    || (ffeinfo_kindtype (info) != ffecom_label_kind ());
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr == NULL) || (ffeinfo_rank (info) != 0)
-	  || (ffebld_op (expr) != FFEBLD_opSYMTER))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextCGOTO:
-    case FFEEXPR_contextFORMAT:
-    case FFEEXPR_contextDIMLIST:
-    case FFEEXPR_contextFILENUM:	/* See equiv code in _ambig_. */
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextARITHIF:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeREAL:
-	  error = FALSE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextSTOP:
-      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
-	break;
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
-	  break;
-
-	case FFEINFO_basictypeCHARACTER:
-	  error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT);
-	  break;
-
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeNONE:
-	  error = FALSE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr != NULL) && ((ffebld_op (expr) != FFEBLD_opCONTER)
-			     || (ffebld_conter_orig (expr) != NULL)))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextINCLUDE:
-      error = (expr == NULL) || (ffeinfo_rank (info) != 0)
-	|| (ffeinfo_basictype (info) != FFEINFO_basictypeCHARACTER)
-	|| (ffebld_op (expr) != FFEBLD_opCONTER)
-	|| (ffebld_conter_orig (expr) != NULL);
-      break;
-
-    case FFEEXPR_contextSELECTCASE:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeCHARACTER:
-	case FFEINFO_basictypeLOGICAL:
-	  error = FALSE;
-	  break;
-
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextCASE:
-      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
-	break;
-      switch ((expr == NULL) ? FFEINFO_basictypeINTEGER
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeCHARACTER:
-	case FFEINFO_basictypeLOGICAL:
-	  error = FALSE;
-	  break;
-
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextCHARACTERSIZE:
-    case FFEEXPR_contextKINDTYPE:
-    case FFEEXPR_contextDIMLISTCOMMON:
-      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
-	break;
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextEQVINDEX_:
-      if ((error = (expr != NULL) && (ffeinfo_rank (info) != 0)))
-	break;
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeNONE:
-	  error = FALSE;
-	  break;
-
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr != NULL) && (ffebld_op (expr) != FFEBLD_opCONTER))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextPARAMETER:
-      if (ffeexpr_stack_->is_rhs)
-	error = (expr == NULL) || (ffeinfo_rank (info) != 0)
-	  || (ffebld_op (expr) != FFEBLD_opCONTER);
-      else
-	error = (expr == NULL) || (ffeinfo_rank (info) != 0)
-	  || (ffebld_op (expr) != FFEBLD_opSYMTER);
-      break;
-
-    case FFEEXPR_contextINDEXORACTUALARG_:
-      if (ffelex_token_type (t) == FFELEX_typeCOLON)
-	ffeexpr_stack_->context = FFEEXPR_contextINDEX_;
-      else
-	ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-      if (ffelex_token_type (t) == FFELEX_typeCOLON)
-	ffeexpr_stack_->context = FFEEXPR_contextINDEX_;
-      else
-	ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-      if (ffelex_token_type (t) == FFELEX_typeCOLON)
-	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEX_;
-      else
-	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-      if (ffelex_token_type (t) == FFELEX_typeCOLON)
-	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFINDEX_;
-      else
-	ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-      goto again;		/* :::::::::::::::::::: */
-
-    case FFEEXPR_contextIMPDOCTRL_:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      if (!ffeexpr_stack_->is_rhs
-	  && (ffebld_op (expr) != FFEBLD_opSYMTER))
-	error = TRUE;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  if (! ffe_is_ugly_logint ())
-	    error = TRUE;
-	  if (! ffeexpr_stack_->is_rhs)
-	    break;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-				  ffeinfo_kindtype (info), 0,
-				  FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  break;
-
-	case FFEINFO_basictypeREAL:
-	  if (!ffeexpr_stack_->is_rhs
-	      && ffe_is_warn_surprising ()
-	      && !error)
-	    {
-	      ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
-	      ffebad_here (0, ffelex_token_where_line (ft),
-			   ffelex_token_where_column (ft));
-	      ffebad_string (ffelex_token_text (ft));
-	      ffebad_finish ();
-	    }
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextDATAIMPDOCTRL_:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      if (ffeexpr_stack_->is_rhs)
-	{
-	  if ((ffebld_op (expr) != FFEBLD_opCONTER)
-	      && (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
-	    error = TRUE;
-	}
-      else if ((ffebld_op (expr) != FFEBLD_opSYMTER)
-	       || (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
-	error = TRUE;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  if (! ffeexpr_stack_->is_rhs)
-	    break;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-				  ffeinfo_kindtype (info), 0,
-				  FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through.  */
-	case FFEINFO_basictypeINTEGER:
-	  if (ffeexpr_stack_->is_rhs
-	      && (ffeinfo_kindtype (ffebld_info (expr))
-		  != FFEINFO_kindtypeINTEGERDEFAULT))
-	    expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-				    FFEINFO_kindtypeINTEGERDEFAULT, 0,
-				    FFETARGET_charactersizeNONE,
-				    FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeREAL:
-	  if (!ffeexpr_stack_->is_rhs
-	      && ffe_is_warn_surprising ()
-	      && !error)
-	    {
-	      ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
-	      ffebad_here (0, ffelex_token_where_line (ft),
-			   ffelex_token_where_column (ft));
-	      ffebad_string (ffelex_token_text (ft));
-	      ffebad_finish ();
-	    }
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextIMPDOITEM_:
-      if (ffelex_token_type (t) == FFELEX_typeEQUALS)
-	{
-	  ffeexpr_stack_->is_rhs = FALSE;
-	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
-	  goto again;		/* :::::::::::::::::::: */
-	}
-      /* Fall through. */
-    case FFEEXPR_contextIOLIST:
-    case FFEEXPR_contextFILEVXTCODE:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  break;
-	}
-      error = (expr == NULL)
-	|| ((ffeinfo_rank (info) != 0)
-	    && ((ffebld_op (expr) != FFEBLD_opSYMTER)
-		|| (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
-		|| (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
-		    == FFEBLD_opSTAR)));	/* Bad if null expr, or if
-						   array that is not a SYMTER
-						   (can't happen yet, I
-						   think) or has a NULL or
-						   STAR (assumed) array
-						   size. */
-      break;
-
-    case FFEEXPR_contextIMPDOITEMDF_:
-      if (ffelex_token_type (t) == FFELEX_typeEQUALS)
-	{
-	  ffeexpr_stack_->is_rhs = FALSE;
-	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
-	  goto again;		/* :::::::::::::::::::: */
-	}
-      /* Fall through. */
-    case FFEEXPR_contextIOLISTDF:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  break;
-	}
-      error
-	= (expr == NULL)
-	  || ((ffeinfo_basictype (info) == FFEINFO_basictypeCHARACTER)
-	      && (ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT))
-	    || ((ffeinfo_rank (info) != 0)
-		&& ((ffebld_op (expr) != FFEBLD_opSYMTER)
-		    || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
-		    || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
-			== FFEBLD_opSTAR)));	/* Bad if null expr,
-						   non-default-kindtype
-						   character expr, or if
-						   array that is not a SYMTER
-						   (can't happen yet, I
-						   think) or has a NULL or
-						   STAR (assumed) array
-						   size. */
-      break;
-
-    case FFEEXPR_contextDATAIMPDOITEM_:
-      error = (expr == NULL)
-	|| (ffebld_op (expr) != FFEBLD_opARRAYREF)
-	|| ((ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR)
-	    && (ffeinfo_where (info) != FFEINFO_whereFLEETING_IADDR));
-      break;
-
-    case FFEEXPR_contextDATAIMPDOINDEX_:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((ffeinfo_where (info) != FFEINFO_whereCONSTANT)
-	  && (ffeinfo_where (info) != FFEINFO_whereIMMEDIATE))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextDATA:
-      if (expr == NULL)
-	error = TRUE;
-      else if (ffeexpr_stack_->is_rhs)
-	error = (ffebld_op (expr) != FFEBLD_opCONTER);
-      else if (ffebld_op (expr) == FFEBLD_opSYMTER)
-	error = FALSE;
-      else
-	error = (ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR);
-      break;
-
-    case FFEEXPR_contextINITVAL:
-      error = (expr == NULL) || (ffebld_op (expr) != FFEBLD_opCONTER);
-      break;
-
-    case FFEEXPR_contextEQUIVALENCE:
-      if (expr == NULL)
-	error = TRUE;
-      else if (ffebld_op (expr) == FFEBLD_opSYMTER)
-	error = FALSE;
-      else
-	error = (ffeinfo_where (info) != FFEINFO_whereFLEETING_CADDR);
-      break;
-
-    case FFEEXPR_contextFILEASSOC:
-    case FFEEXPR_contextFILEINT:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  /* Maybe this should be supported someday, but, right now,
-	     g77 can't generate a call to libf2c to write to an
-	     integer other than the default size.  */
-	  error = ((! ffeexpr_stack_->is_rhs)
-		   && ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextFILEDFINT:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  error = (ffeinfo_kindtype (info) != FFEINFO_kindtypeINTEGERDEFAULT);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextFILELOG:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  error = FALSE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextFILECHAR:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeCHARACTER:
-	  error = FALSE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextFILENUMCHAR:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeCHARACTER:
-	  error = FALSE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextFILEDFCHAR:
-      if ((error = (expr == NULL) || (ffeinfo_rank (info) != 0)))
-	break;
-      switch (ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeCHARACTER:
-	  error
-	    = (ffeinfo_kindtype (info)
-	       != FFEINFO_kindtypeCHARACTERDEFAULT);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if (!ffeexpr_stack_->is_rhs
-	  && (ffebld_op (expr) == FFEBLD_opSUBSTR))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextFILEUNIT:	/* See equiv code in _ambig_. */
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  if ((error = (ffeinfo_rank (info) != 0)))
-	    break;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if ((error = (ffeinfo_rank (info) != 0)))
-	    break;
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  if ((error = (ffeinfo_rank (info) != 0)))
-	    break;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeCHARACTER:
-	  switch (ffebld_op (expr))
-	    {			/* As if _lhs had been called instead of
-				   _rhs. */
-	    case FFEBLD_opSYMTER:
-	      error
-		= (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereCONSTANT);
-	      break;
-
-	    case FFEBLD_opSUBSTR:
-	      error = (ffeinfo_where (ffebld_info (expr))
-		       == FFEINFO_whereCONSTANT_SUBOBJECT);
-	      break;
-
-	    case FFEBLD_opARRAYREF:
-	      error = FALSE;
-	      break;
-
-	    default:
-	      error = TRUE;
-	      break;
-	    }
-	  if (!error
-	   && ((ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
-	       || ((ffeinfo_rank (info) != 0)
-		   && ((ffebld_op (expr) != FFEBLD_opSYMTER)
-		     || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
-		  || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
-		      == FFEBLD_opSTAR)))))	/* Bad if
-						   non-default-kindtype
-						   character expr, or if
-						   array that is not a SYMTER
-						   (can't happen yet, I
-						   think), or has a NULL or
-						   STAR (assumed) array
-						   size. */
-	    error = TRUE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextFILEFORMAT:
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeINTEGER:
-	  error = (expr == NULL)
-	    || ((ffeinfo_rank (info) != 0) ?
-		ffe_is_pedantic ()	/* F77 C5. */
-		: (bool) (ffeinfo_kindtype (info) != ffecom_label_kind ()))
-	    || (ffebld_op (expr) != FFEBLD_opSYMTER);
-	  break;
-
-	case FFEINFO_basictypeLOGICAL:
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  /* F77 C5 -- must be an array of hollerith.  */
-	  error
-	    = ffe_is_pedantic ()
-	      || (ffeinfo_rank (info) == 0);
-	  break;
-
-	case FFEINFO_basictypeCHARACTER:
-	  if ((ffeinfo_kindtype (info) != FFEINFO_kindtypeCHARACTERDEFAULT)
-	      || ((ffeinfo_rank (info) != 0)
-		  && ((ffebld_op (expr) != FFEBLD_opSYMTER)
-		      || (ffesymbol_arraysize (ffebld_symter (expr)) == NULL)
-		      || (ffebld_op (ffesymbol_arraysize (ffebld_symter (expr)))
-			  == FFEBLD_opSTAR))))	/* Bad if
-						   non-default-kindtype
-						   character expr, or if
-						   array that is not a SYMTER
-						   (can't happen yet, I
-						   think), or has a NULL or
-						   STAR (assumed) array
-						   size. */
-	    error = TRUE;
-	  else
-	    error = FALSE;
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    case FFEEXPR_contextLOC_:
-      /* See also ffeintrin_check_loc_.  */
-      if ((expr == NULL)
-	  || (ffeinfo_kind (info) != FFEINFO_kindENTITY)
-	  || ((ffebld_op (expr) != FFEBLD_opSYMTER)
-	      && (ffebld_op (expr) != FFEBLD_opSUBSTR)
-	      && (ffebld_op (expr) != FFEBLD_opARRAYREF)))
-	error = TRUE;
-      break;
-
-    default:
-      error = FALSE;
-      break;
-    }
-
-  if (error && ((expr == NULL) || (ffebld_op (expr) != FFEBLD_opANY)))
-    {
-      ffebad_start (FFEBAD_EXPR_WRONG);
-      ffebad_here (0, ffelex_token_where_line (ft),
-		   ffelex_token_where_column (ft));
-      ffebad_finish ();
-      expr = ffebld_new_any ();
-      ffebld_set_info (expr, ffeinfo_new_any ());
-    }
-
-  callback = ffeexpr_stack_->callback;
-  s = ffeexpr_stack_->previous;
-  malloc_kill_ks (ffe_pool_program_unit (), ffeexpr_stack_,
-		  sizeof (*ffeexpr_stack_));
-  ffeexpr_stack_ = s;
-  next = (ffelexHandler) (*callback) (ft, expr, t);
-  ffelex_token_kill (ft);
-  return (ffelexHandler) next;
-}
-
-/* ffeexpr_finished_ambig_ -- Check validity of ambiguous unit/form spec
-
-   ffebld expr;
-   expr = ffeexpr_finished_ambig_(expr);
-
-   Replicates a bit of ffeexpr_finished_'s task when in a context
-   of UNIT or FORMAT.  */
-
-static ffebld
-ffeexpr_finished_ambig_ (ffelexToken ft, ffebld expr)
-{
-  ffeinfo info = ffebld_info (expr);
-  bool error;
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextFILENUMAMBIG:	/* Same as FILENUM in _finished_. */
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = FALSE;
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      if ((expr == NULL) || (ffeinfo_rank (info) != 0))
-	error = TRUE;
-      break;
-
-    case FFEEXPR_contextFILEUNITAMBIG:	/* Same as FILEUNIT in _finished_. */
-      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
-	{
-	  error = FALSE;
-	  break;
-	}
-      switch ((expr == NULL) ? FFEINFO_basictypeNONE
-	      : ffeinfo_basictype (info))
-	{
-	case FFEINFO_basictypeLOGICAL:
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeLOGICAL,
-	     FFEINFO_kindtypeLOGICALDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  /* Fall through. */
-	case FFEINFO_basictypeREAL:
-	case FFEINFO_basictypeCOMPLEX:
-	  if (ffe_is_pedantic ())
-	    {
-	      error = TRUE;
-	      break;
-	    }
-	  /* Fall through. */
-	case FFEINFO_basictypeINTEGER:
-	case FFEINFO_basictypeHOLLERITH:
-	case FFEINFO_basictypeTYPELESS:
-	  error = (ffeinfo_rank (info) != 0);
-	  expr = ffeexpr_convert (expr, ft, ft, FFEINFO_basictypeINTEGER,
-	     FFEINFO_kindtypeINTEGERDEFAULT, 0, FFETARGET_charactersizeNONE,
-				  FFEEXPR_contextLET);
-	  break;
-
-	case FFEINFO_basictypeCHARACTER:
-	  switch (ffebld_op (expr))
-	    {			/* As if _lhs had been called instead of
-				   _rhs. */
-	    case FFEBLD_opSYMTER:
-	      error
-		= (ffeinfo_where (ffebld_info (expr)) == FFEINFO_whereCONSTANT);
-	      break;
-
-	    case FFEBLD_opSUBSTR:
-	      error = (ffeinfo_where (ffebld_info (expr))
-		       == FFEINFO_whereCONSTANT_SUBOBJECT);
-	      break;
-
-	    case FFEBLD_opARRAYREF:
-	      error = FALSE;
-	      break;
-
-	    default:
-	      error = TRUE;
-	      break;
-	    }
-	  break;
-
-	default:
-	  error = TRUE;
-	  break;
-	}
-      break;
-
-    default:
-      assert ("bad context" == NULL);
-      error = TRUE;
-      break;
-    }
-
-  if (error && ((expr == NULL) || (ffebld_op (expr) != FFEBLD_opANY)))
-    {
-      ffebad_start (FFEBAD_EXPR_WRONG);
-      ffebad_here (0, ffelex_token_where_line (ft),
-		   ffelex_token_where_column (ft));
-      ffebad_finish ();
-      expr = ffebld_new_any ();
-      ffebld_set_info (expr, ffeinfo_new_any ());
-    }
-
-  return expr;
-}
-
-/* ffeexpr_token_lhs_ -- Initial state for lhs expression
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Basically a smaller version of _rhs_; keep them both in sync, of course.  */
-
-static ffelexHandler
-ffeexpr_token_lhs_ (ffelexToken t)
-{
-
-  /* When changing the list of valid initial lhs tokens, check whether to
-     update a corresponding list in ffeexpr_cb_close_paren_ambig_1_ for the
-     READ (expr) <token> case -- it assumes it knows which tokens <token> can
-     be to indicate an lhs (or implied DO), which right now is the set
-     {NAME,OPEN_PAREN}.
-
-     This comment also appears in ffeexpr_token_first_lhs_. */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_name_lhs_;
-
-    default:
-      return (ffelexHandler) ffeexpr_finished_ (t);
-    }
-}
-
-/* ffeexpr_token_rhs_ -- Initial state for rhs expression
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   The initial state and the post-binary-operator state are the same and
-   both handled here, with the expression stack used to distinguish
-   between them.  Binary operators are invalid here; unary operators,
-   constants, subexpressions, and name references are valid.  */
-
-static ffelexHandler
-ffeexpr_token_rhs_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeQUOTE:
-      if (ffe_is_vxt ())
-	{
-	  ffeexpr_tokens_[0] = ffelex_token_use (t);
-	  return (ffelexHandler) ffeexpr_token_quote_;
-	}
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      ffelex_set_expecting_hollerith (-1, '\"',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));
-      /* Don't have to unset this one. */
-      return (ffelexHandler) ffeexpr_token_apostrophe_;
-
-    case FFELEX_typeAPOSTROPHE:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      ffelex_set_expecting_hollerith (-1, '\'',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));
-      /* Don't have to unset this one. */
-      return (ffelexHandler) ffeexpr_token_apostrophe_;
-
-    case FFELEX_typePERCENT:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_percent_;
-
-    case FFELEX_typeOPEN_PAREN:
-      ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  FFEEXPR_contextPAREN_,
-					  ffeexpr_cb_close_paren_c_);
-
-    case FFELEX_typePLUS:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeUNARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorADD_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceADD_;
-      e->u.operator.as = FFEEXPR_operatorassociativityADD_;
-      ffeexpr_exprstack_push_unary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeMINUS:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeUNARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorSUBTRACT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceSUBTRACT_;
-      e->u.operator.as = FFEEXPR_operatorassociativitySUBTRACT_;
-      ffeexpr_exprstack_push_unary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typePERIOD:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_period_;
-
-    case FFELEX_typeNUMBER:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      ffeexpr_hollerith_count_ = atol (ffelex_token_text (t));
-      if (ffeexpr_hollerith_count_ > 0)
-	ffelex_set_expecting_hollerith (ffeexpr_hollerith_count_,
-					'\0',
-					ffelex_token_where_line (t),
-					ffelex_token_where_column (t));
-      return (ffelexHandler) ffeexpr_token_number_;
-
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextACTUALARG_:
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  return (ffelexHandler) ffeexpr_token_name_arg_;
-
-	default:
-	  return (ffelexHandler) ffeexpr_token_name_rhs_;
-	}
-
-    case FFELEX_typeASTERISK:
-    case FFELEX_typeSLASH:
-    case FFELEX_typePOWER:
-    case FFELEX_typeCONCAT:
-    case FFELEX_typeREL_EQ:
-    case FFELEX_typeREL_NE:
-    case FFELEX_typeREL_LE:
-    case FFELEX_typeREL_GE:
-      if (ffest_ffebad_start (FFEBAD_MISSING_FIRST_BINARY_OPERAND))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-#if 0
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-    case FFELEX_typeCLOSE_ANGLE:
-    case FFELEX_typeCLOSE_PAREN:
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLON:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-#endif
-    default:
-      return (ffelexHandler) ffeexpr_finished_ (t);
-    }
-}
-
-/* ffeexpr_token_period_ -- Rhs PERIOD
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle a period detected at rhs (expecting unary op or operand) state.
-   Must begin a floating-point value (as in .12) or a dot-dot name, of
-   which only .NOT., .TRUE., and .FALSE. are truly valid.  Other sort-of-
-   valid names represent binary operators, which are invalid here because
-   there isn't an operand at the top of the stack.  */
-
-static ffelexHandler
-ffeexpr_token_period_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_current_dotdot_ = ffestr_other (t);
-      switch (ffeexpr_current_dotdot_)
-	{
-	case FFESTR_otherNone:
-	  if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-			   ffelex_token_where_column (ffeexpr_tokens_[0]));
-	      ffebad_finish ();
-	    }
-	  ffelex_token_kill (ffeexpr_tokens_[0]);
-	  return (ffelexHandler) ffeexpr_token_rhs_ (t);
-
-	case FFESTR_otherTRUE:
-	case FFESTR_otherFALSE:
-	case FFESTR_otherNOT:
-	  ffeexpr_tokens_[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffeexpr_token_end_period_;
-
-	default:
-	  if (ffest_ffebad_start (FFEBAD_MISSING_FIRST_BINARY_OPERAND))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_finish ();
-	    }
-	  ffelex_token_kill (ffeexpr_tokens_[0]);
-	  return (ffelexHandler) ffeexpr_token_swallow_period_;
-	}
-      break;			/* Nothing really reaches here. */
-
-    case FFELEX_typeNUMBER:
-      ffeexpr_tokens_[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_real_;
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      return (ffelexHandler) ffeexpr_token_rhs_ (t);
-    }
-}
-
-/* ffeexpr_token_end_period_ -- Rhs PERIOD NAME(NOT, TRUE, or FALSE)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Expecting a period to close a .NOT, .TRUE, or .FALSE at rhs (unary op
-   or operator) state.	If period isn't found, issue a diagnostic but
-   pretend we saw one.	ffeexpr_current_dotdot_ must already contained the
-   dotdot representation of the name in between the two PERIOD tokens.	*/
-
-static ffelexHandler
-ffeexpr_token_end_period_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    {
-      if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
-	  ffebad_finish ();
-	}
-    }
-
-  ffelex_token_kill (ffeexpr_tokens_[1]);	/* Kill "NOT"/"TRUE"/"FALSE"
-						   token. */
-
-  e = ffeexpr_expr_new_ ();
-  e->token = ffeexpr_tokens_[0];
-
-  switch (ffeexpr_current_dotdot_)
-    {
-    case FFESTR_otherNOT:
-      e->type = FFEEXPR_exprtypeUNARY_;
-      e->u.operator.op = FFEEXPR_operatorNOT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceNOT_;
-      e->u.operator.as = FFEEXPR_operatorassociativityNOT_;
-      ffeexpr_exprstack_push_unary_ (e);
-      if (ffelex_token_type (t) != FFELEX_typePERIOD)
-	return (ffelexHandler) ffeexpr_token_rhs_ (t);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFESTR_otherTRUE:
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->u.operand
-	= ffebld_new_conter (ffebld_constant_new_logicaldefault (TRUE));
-      ffebld_set_info (e->u.operand,
-      ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
-		   0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-      ffeexpr_exprstack_push_operand_ (e);
-      if (ffelex_token_type (t) != FFELEX_typePERIOD)
-	return (ffelexHandler) ffeexpr_token_binary_ (t);
-      return (ffelexHandler) ffeexpr_token_binary_;
-
-    case FFESTR_otherFALSE:
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->u.operand
-	= ffebld_new_conter (ffebld_constant_new_logicaldefault (FALSE));
-      ffebld_set_info (e->u.operand,
-      ffeinfo_new (FFEINFO_basictypeLOGICAL, FFEINFO_kindtypeLOGICALDEFAULT,
-		   0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-      ffeexpr_exprstack_push_operand_ (e);
-      if (ffelex_token_type (t) != FFELEX_typePERIOD)
-	return (ffelexHandler) ffeexpr_token_binary_ (t);
-      return (ffelexHandler) ffeexpr_token_binary_;
-
-    default:
-      assert ("Bad unary dotdot in ffeexpr_current_dotdot_" == NULL);
-      exit (0);
-      return NULL;
-    }
-}
-
-/* ffeexpr_token_swallow_period_ -- Rhs PERIOD NAME(not NOT, TRUE, or FALSE)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   A diagnostic has already been issued; just swallow a period if there is
-   one, then continue with ffeexpr_token_rhs_.	*/
-
-static ffelexHandler
-ffeexpr_token_swallow_period_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    return (ffelexHandler) ffeexpr_token_rhs_ (t);
-
-  return (ffelexHandler) ffeexpr_token_rhs_;
-}
-
-/* ffeexpr_token_real_ -- Rhs PERIOD NUMBER
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   After a period and a string of digits, check next token for possible
-   exponent designation (D, E, or Q as first/only character) and continue
-   real-number handling accordingly.  Else form basic real constant, push
-   onto expression stack, and enter binary state using current token (which,
-   if it is a name not beginning with D, E, or Q, will certainly result
-   in an error, but that's not for this routine to deal with).	*/
-
-static ffelexHandler
-ffeexpr_token_real_ (ffelexToken t)
-{
-  char d;
-  const char *p;
-
-  if (((ffelex_token_type (t) != FFELEX_typeNAME)
-       && (ffelex_token_type (t) != FFELEX_typeNAMES))
-      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				     'D', 'd')
-	     || ffesrc_char_match_init (d, 'E', 'e')
-	     || ffesrc_char_match_init (d, 'Q', 'q')))
-	   && ffeexpr_isdigits_ (++p)))
-    {
-#if 0
-      /* This code has been removed because it seems inconsistent to
-	 produce a diagnostic in this case, but not all of the other
-	 ones that look for an exponent and cannot recognize one.  */
-      if (((ffelex_token_type (t) == FFELEX_typeNAME)
-	   || (ffelex_token_type (t) == FFELEX_typeNAMES))
-	  && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT))
-	{
-	  char bad[2];
-
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  bad[0] = *(p - 1);
-	  bad[1] = '\0';
-	  ffebad_string (bad);
-	  ffebad_finish ();
-	}
-#endif
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  /* Just exponent character by itself?	 In which case, PLUS or MINUS must
-     surely be next, followed by a NUMBER token. */
-
-  if (*p == '\0')
-    {
-      ffeexpr_tokens_[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_real_exponent_;
-    }
-
-  ffeexpr_make_float_const_ (d, NULL, ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-			     t, NULL, NULL);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_real_exponent_ -- Rhs PERIOD NUMBER NAME(D, E, or Q)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Ensures this token is PLUS or MINUS, preserves it, goes to final state
-   for real number (exponent digits).  Else issues diagnostic, assumes a
-   zero exponent field for number, passes token on to binary state as if
-   previous token had been "E0" instead of "E", for example.  */
-
-static ffelexHandler
-ffeexpr_token_real_exponent_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    {
-      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
-		       ffelex_token_where_column (ffeexpr_tokens_[2]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  ffeexpr_tokens_[3] = ffelex_token_use (t);
-  return (ffelexHandler) ffeexpr_token_real_exp_sign_;
-}
-
-/* ffeexpr_token_real_exp_sign_ -- Rhs PERIOD NUMBER NAME(D,E,Q) PLUS/MINUS
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Make sure token is a NUMBER, make a real constant out of all we have and
-   push it onto the expression stack.  Else issue diagnostic and pretend
-   exponent field was a zero.  */
-
-static ffelexHandler
-ffeexpr_token_real_exp_sign_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    {
-      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
-		       ffelex_token_where_column (ffeexpr_tokens_[2]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'), NULL,
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      ffelex_token_kill (ffeexpr_tokens_[3]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[2])[0], NULL,
-		 ffeexpr_tokens_[0], ffeexpr_tokens_[1], ffeexpr_tokens_[2],
-			     ffeexpr_tokens_[3], t);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffelex_token_kill (ffeexpr_tokens_[2]);
-  ffelex_token_kill (ffeexpr_tokens_[3]);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_number_ -- Rhs NUMBER
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   If the token is a period, we may have a floating-point number, or an
-   integer followed by a dotdot binary operator.  If the token is a name
-   beginning with D, E, or Q, we definitely have a floating-point number.
-   If the token is a hollerith constant, that's what we've got, so push
-   it onto the expression stack and continue with the binary state.
-
-   Otherwise, we have an integer followed by something the binary state
-   should be able to swallow.  */
-
-static ffelexHandler
-ffeexpr_token_number_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffeinfo ni;
-  char d;
-  const char *p;
-
-  if (ffeexpr_hollerith_count_ > 0)
-    ffelex_set_expecting_hollerith (0, '\0',
-				    ffewhere_line_unknown (),
-				    ffewhere_column_unknown ());
-
-  /* See if we've got a floating-point number here. */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				   'D', 'd')
-	   || ffesrc_char_match_init (d, 'E', 'e')
-	   || ffesrc_char_match_init (d, 'Q', 'q'))
-	  && ffeexpr_isdigits_ (++p))
-	{
-
-	  /* Just exponent character by itself?	 In which case, PLUS or MINUS
-	     must surely be next, followed by a NUMBER token. */
-
-	  if (*p == '\0')
-	    {
-	      ffeexpr_tokens_[1] = ffelex_token_use (t);
-	      return (ffelexHandler) ffeexpr_token_number_exponent_;
-	    }
-	  ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], NULL, NULL, t,
-				     NULL, NULL);
-
-	  ffelex_token_kill (ffeexpr_tokens_[0]);
-	  return (ffelexHandler) ffeexpr_token_binary_;
-	}
-      break;
-
-    case FFELEX_typePERIOD:
-      ffeexpr_tokens_[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_number_period_;
-
-    case FFELEX_typeHOLLERITH:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->token = ffeexpr_tokens_[0];
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_hollerith (t));
-      ni = ffeinfo_new (FFEINFO_basictypeHOLLERITH, FFEINFO_kindtypeNONE,
-			0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
-			ffelex_token_length (t));
-      ffebld_set_info (e->u.operand, ni);
-      ffeexpr_exprstack_push_operand_ (e);
-      return (ffelexHandler) ffeexpr_token_binary_;
-
-    default:
-      break;
-    }
-
-  /* Nothing specific we were looking for, so make an integer and pass the
-     current token to the binary state. */
-
-  ffeexpr_make_float_const_ ('I', ffeexpr_tokens_[0], NULL, NULL,
-			     NULL, NULL, NULL);
-  return (ffelexHandler) ffeexpr_token_binary_ (t);
-}
-
-/* ffeexpr_token_number_exponent_ -- Rhs NUMBER NAME(D, E, or Q)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Ensures this token is PLUS or MINUS, preserves it, goes to final state
-   for real number (exponent digits).  Else treats number as integer, passes
-   name to binary, passes current token to subsequent handler.  */
-
-static ffelexHandler
-ffeexpr_token_number_exponent_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    {
-      ffeexprExpr_ e;
-      ffelexHandler nexthandler;
-
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->token = ffeexpr_tokens_[0];
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
-					(ffeexpr_tokens_[0]));
-      ffebld_set_info (e->u.operand,
-      ffeinfo_new (FFEINFO_basictypeINTEGER, FFEINFO_kindtypeINTEGERDEFAULT,
-		   0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-      ffeexpr_exprstack_push_operand_ (e);
-      nexthandler = (ffelexHandler) ffeexpr_token_binary_ (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      return (ffelexHandler) (*nexthandler) (t);
-    }
-
-  ffeexpr_tokens_[2] = ffelex_token_use (t);
-  return (ffelexHandler) ffeexpr_token_number_exp_sign_;
-}
-
-/* ffeexpr_token_number_exp_sign_ -- Rhs NUMBER NAME(D,E,Q) PLUS/MINUS
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Make sure token is a NUMBER, make a real constant out of all we have and
-   push it onto the expression stack.  Else issue diagnostic and pretend
-   exponent field was a zero.  */
-
-static ffelexHandler
-ffeexpr_token_number_exp_sign_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    {
-      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[1]),
-		       ffelex_token_where_column (ffeexpr_tokens_[1]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[1])[0],
-				 ffeexpr_tokens_[0], NULL, NULL,
-				 ffeexpr_tokens_[1], ffeexpr_tokens_[2],
-				 NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[1])[0],
-			     ffeexpr_tokens_[0], NULL, NULL,
-			     ffeexpr_tokens_[1], ffeexpr_tokens_[2], t);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffelex_token_kill (ffeexpr_tokens_[2]);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_number_period_ -- Rhs NUMBER PERIOD
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle a period detected following a number at rhs state.  Must begin a
-   floating-point value (as in 1., 1.2, 1.E3, or 1.E+3) or a dot-dot name.  */
-
-static ffelexHandler
-ffeexpr_token_number_period_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffelexHandler nexthandler;
-  const char *p;
-  char d;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      if ((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				   'D', 'd')
-	   || ffesrc_char_match_init (d, 'E', 'e')
-	   || ffesrc_char_match_init (d, 'Q', 'q'))
-	  && ffeexpr_isdigits_ (++p))
-	{
-
-	  /* Just exponent character by itself?	 In which case, PLUS or MINUS
-	     must surely be next, followed by a NUMBER token. */
-
-	  if (*p == '\0')
-	    {
-	      ffeexpr_tokens_[2] = ffelex_token_use (t);
-	      return (ffelexHandler) ffeexpr_token_number_per_exp_;
-	    }
-	  ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0],
-				     ffeexpr_tokens_[1], NULL, t, NULL,
-				     NULL);
-
-	  ffelex_token_kill (ffeexpr_tokens_[0]);
-	  ffelex_token_kill (ffeexpr_tokens_[1]);
-	  return (ffelexHandler) ffeexpr_token_binary_;
-	}
-      /* A name not representing an exponent, so assume it will be something
-	 like EQ, make an integer from the number, pass the period to binary
-	 state and the current token to the resulting state. */
-
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->token = ffeexpr_tokens_[0];
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
-					(ffeexpr_tokens_[0]));
-      ffebld_set_info (e->u.operand,
-		       ffeinfo_new (FFEINFO_basictypeINTEGER,
-				    FFEINFO_kindtypeINTEGERDEFAULT, 0,
-				  FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
-				    FFETARGET_charactersizeNONE));
-      ffeexpr_exprstack_push_operand_ (e);
-      nexthandler = (ffelexHandler) ffeexpr_token_binary_
-	(ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      return (ffelexHandler) (*nexthandler) (t);
-
-    case FFELEX_typeNUMBER:
-      ffeexpr_tokens_[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_number_real_;
-
-    default:
-      break;
-    }
-
-  /* Nothing specific we were looking for, so make a real number and pass the
-     period and then the current token to the binary state. */
-
-  ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
-			     ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-			     NULL, NULL, NULL, NULL);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  return (ffelexHandler) ffeexpr_token_binary_ (t);
-}
-
-/* ffeexpr_token_number_per_exp_ -- Rhs NUMBER PERIOD NAME(D, E, or Q)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Ensures this token is PLUS or MINUS, preserves it, goes to final state
-   for real number (exponent digits).  Else treats number as real, passes
-   name to binary, passes current token to subsequent handler.	*/
-
-static ffelexHandler
-ffeexpr_token_number_per_exp_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    {
-      ffelexHandler nexthandler;
-
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 NULL, NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      nexthandler = (ffelexHandler) ffeexpr_token_binary_ (ffeexpr_tokens_[2]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      return (ffelexHandler) (*nexthandler) (t);
-    }
-
-  ffeexpr_tokens_[3] = ffelex_token_use (t);
-  return (ffelexHandler) ffeexpr_token_num_per_exp_sign_;
-}
-
-/* ffeexpr_token_number_real_ -- Rhs NUMBER PERIOD NUMBER
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   After a number, period, and number, check next token for possible
-   exponent designation (D, E, or Q as first/only character) and continue
-   real-number handling accordingly.  Else form basic real constant, push
-   onto expression stack, and enter binary state using current token (which,
-   if it is a name not beginning with D, E, or Q, will certainly result
-   in an error, but that's not for this routine to deal with).	*/
-
-static ffelexHandler
-ffeexpr_token_number_real_ (ffelexToken t)
-{
-  char d;
-  const char *p;
-
-  if (((ffelex_token_type (t) != FFELEX_typeNAME)
-       && (ffelex_token_type (t) != FFELEX_typeNAMES))
-      || !(((ffesrc_char_match_init ((d = *(p = ffelex_token_text (t))),
-				     'D', 'd')
-	     || ffesrc_char_match_init (d, 'E', 'e')
-	     || ffesrc_char_match_init (d, 'Q', 'q')))
-	   && ffeexpr_isdigits_ (++p)))
-    {
-#if 0
-      /* This code has been removed because it seems inconsistent to
-	 produce a diagnostic in this case, but not all of the other
-	 ones that look for an exponent and cannot recognize one.  */
-      if (((ffelex_token_type (t) == FFELEX_typeNAME)
-	   || (ffelex_token_type (t) == FFELEX_typeNAMES))
-	  && ffest_ffebad_start (FFEBAD_INVALID_EXPONENT))
-	{
-	  char bad[2];
-
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  bad[0] = *(p - 1);
-	  bad[1] = '\0';
-	  ffebad_string (bad);
-	  ffebad_finish ();
-	}
-#endif
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 ffeexpr_tokens_[2], NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  /* Just exponent character by itself?	 In which case, PLUS or MINUS must
-     surely be next, followed by a NUMBER token. */
-
-  if (*p == '\0')
-    {
-      ffeexpr_tokens_[3] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_number_real_exp_;
-    }
-
-  ffeexpr_make_float_const_ (d, ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-			     ffeexpr_tokens_[2], t, NULL, NULL);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffelex_token_kill (ffeexpr_tokens_[2]);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_num_per_exp_sign_ -- Rhs NUMBER PERIOD NAME(D,E,Q) PLUS/MINUS
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Make sure token is a NUMBER, make a real constant out of all we have and
-   push it onto the expression stack.  Else issue diagnostic and pretend
-   exponent field was a zero.  */
-
-static ffelexHandler
-ffeexpr_token_num_per_exp_sign_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    {
-      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[2]),
-		       ffelex_token_where_column (ffeexpr_tokens_[2]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 NULL, NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      ffelex_token_kill (ffeexpr_tokens_[3]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[2])[0],
-			     ffeexpr_tokens_[0], ffeexpr_tokens_[1], NULL,
-			     ffeexpr_tokens_[2], ffeexpr_tokens_[3], t);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffelex_token_kill (ffeexpr_tokens_[2]);
-  ffelex_token_kill (ffeexpr_tokens_[3]);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_number_real_exp_ -- Rhs NUMBER PERIOD NUMBER NAME(D, E, or Q)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Ensures this token is PLUS or MINUS, preserves it, goes to final state
-   for real number (exponent digits).  Else issues diagnostic, assumes a
-   zero exponent field for number, passes token on to binary state as if
-   previous token had been "E0" instead of "E", for example.  */
-
-static ffelexHandler
-ffeexpr_token_number_real_exp_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typePLUS)
-      && (ffelex_token_type (t) != FFELEX_typeMINUS))
-    {
-      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[3]),
-		       ffelex_token_where_column (ffeexpr_tokens_[3]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 ffeexpr_tokens_[2], NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      ffelex_token_kill (ffeexpr_tokens_[3]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  ffeexpr_tokens_[4] = ffelex_token_use (t);
-  return (ffelexHandler) ffeexpr_token_num_real_exp_sn_;
-}
-
-/* ffeexpr_token_num_real_exp_sn_ -- Rhs NUMBER PERIOD NUMBER NAME(D,E,Q)
-				  PLUS/MINUS
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Make sure token is a NUMBER, make a real constant out of all we have and
-   push it onto the expression stack.  Else issue diagnostic and pretend
-   exponent field was a zero.  */
-
-static ffelexHandler
-ffeexpr_token_num_real_exp_sn_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    {
-      if (ffest_ffebad_start (FFEBAD_MISSING_EXPONENT_VALUE))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[3]),
-		       ffelex_token_where_column (ffeexpr_tokens_[3]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      ffeexpr_make_float_const_ (ffesrc_char_internal_init ('E', 'e'),
-				 ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-				 ffeexpr_tokens_[2], NULL, NULL, NULL);
-
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      ffelex_token_kill (ffeexpr_tokens_[3]);
-      ffelex_token_kill (ffeexpr_tokens_[4]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-
-  ffeexpr_make_float_const_ (ffelex_token_text (ffeexpr_tokens_[3])[0],
-			     ffeexpr_tokens_[0], ffeexpr_tokens_[1],
-			     ffeexpr_tokens_[2], ffeexpr_tokens_[3],
-			     ffeexpr_tokens_[4], t);
-
-  ffelex_token_kill (ffeexpr_tokens_[0]);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffelex_token_kill (ffeexpr_tokens_[2]);
-  ffelex_token_kill (ffeexpr_tokens_[3]);
-  ffelex_token_kill (ffeexpr_tokens_[4]);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_binary_ -- Handle binary operator possibility
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   The possibility of a binary operator is handled here, meaning the previous
-   token was an operand.  */
-
-static ffelexHandler
-ffeexpr_token_binary_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  if (!ffeexpr_stack_->is_rhs)
-    return (ffelexHandler) ffeexpr_finished_ (t);	/* For now. */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typePLUS:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorADD_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceADD_;
-      e->u.operator.as = FFEEXPR_operatorassociativityADD_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeMINUS:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorSUBTRACT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceSUBTRACT_;
-      e->u.operator.as = FFEEXPR_operatorassociativitySUBTRACT_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeASTERISK:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextDATA:
-	  return (ffelexHandler) ffeexpr_finished_ (t);
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorMULTIPLY_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceMULTIPLY_;
-      e->u.operator.as = FFEEXPR_operatorassociativityMULTIPLY_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeSLASH:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextDATA:
-	  return (ffelexHandler) ffeexpr_finished_ (t);
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorDIVIDE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceDIVIDE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityDIVIDE_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typePOWER:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorPOWER_;
-      e->u.operator.prec = FFEEXPR_operatorprecedencePOWER_;
-      e->u.operator.as = FFEEXPR_operatorassociativityPOWER_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeCONCAT:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorCONCATENATE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceCONCATENATE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityCONCATENATE_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeOPEN_ANGLE:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFORMAT:
-	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  break;
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorLT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
-      e->u.operator.as = FFEEXPR_operatorassociativityLT_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeCLOSE_ANGLE:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFORMAT:
-	  return ffeexpr_finished_ (t);
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorGT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
-      e->u.operator.as = FFEEXPR_operatorassociativityGT_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeREL_EQ:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFORMAT:
-	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  break;
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorEQ_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
-      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeREL_NE:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFORMAT:
-	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  break;
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorNE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityNE_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeREL_LE:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFORMAT:
-	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  break;
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorLE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityLE_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typeREL_GE:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextFORMAT:
-	  ffebad_start (FFEBAD_FORMAT_EXPR_TOKEN);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  break;
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorGE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityGE_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_;
-
-    case FFELEX_typePERIOD:
-      ffeexpr_tokens_[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_binary_period_;
-
-#if 0
-    case FFELEX_typeOPEN_PAREN:
-    case FFELEX_typeCLOSE_PAREN:
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLON:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-#endif
-    default:
-      return (ffelexHandler) ffeexpr_finished_ (t);
-    }
-}
-
-/* ffeexpr_token_binary_period_ -- Binary PERIOD
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle a period detected at binary (expecting binary op or end) state.
-   Must begin a dot-dot name, of which .NOT., .TRUE., and .FALSE. are not
-   valid.  */
-
-static ffelexHandler
-ffeexpr_token_binary_period_ (ffelexToken t)
-{
-  ffeexprExpr_ operand;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_current_dotdot_ = ffestr_other (t);
-      switch (ffeexpr_current_dotdot_)
-	{
-	case FFESTR_otherTRUE:
-	case FFESTR_otherFALSE:
-	case FFESTR_otherNOT:
-	  if (ffest_ffebad_start (FFEBAD_MISSING_BINARY_OPERATOR))
-	    {
-	      operand = ffeexpr_stack_->exprstack;
-	      assert (operand != NULL);
-	      assert (operand->type == FFEEXPR_exprtypeOPERAND_);
-	      ffebad_here (0, ffelex_token_where_line (operand->token), ffelex_token_where_column (operand->token));
-	      ffebad_here (1, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_finish ();
-	    }
-	  ffelex_token_kill (ffeexpr_tokens_[0]);
-	  return (ffelexHandler) ffeexpr_token_binary_sw_per_;
-
-	default:
-	  ffeexpr_tokens_[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffeexpr_token_binary_end_per_;
-	}
-      break;			/* Nothing really reaches here. */
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_IGNORING_PERIOD))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-}
-
-/* ffeexpr_token_binary_end_per_ -- Binary PERIOD NAME(not NOT, TRUE, or FALSE)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Expecting a period to close a dot-dot at binary (binary op
-   or operator) state.	If period isn't found, issue a diagnostic but
-   pretend we saw one.	ffeexpr_current_dotdot_ must already contained the
-   dotdot representation of the name in between the two PERIOD tokens.	*/
-
-static ffelexHandler
-ffeexpr_token_binary_end_per_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeBINARY_;
-  e->token = ffeexpr_tokens_[0];
-
-  switch (ffeexpr_current_dotdot_)
-    {
-    case FFESTR_otherAND:
-      e->u.operator.op = FFEEXPR_operatorAND_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceAND_;
-      e->u.operator.as = FFEEXPR_operatorassociativityAND_;
-      break;
-
-    case FFESTR_otherOR:
-      e->u.operator.op = FFEEXPR_operatorOR_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceOR_;
-      e->u.operator.as = FFEEXPR_operatorassociativityOR_;
-      break;
-
-    case FFESTR_otherXOR:
-      e->u.operator.op = FFEEXPR_operatorXOR_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceXOR_;
-      e->u.operator.as = FFEEXPR_operatorassociativityXOR_;
-      break;
-
-    case FFESTR_otherEQV:
-      e->u.operator.op = FFEEXPR_operatorEQV_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceEQV_;
-      e->u.operator.as = FFEEXPR_operatorassociativityEQV_;
-      break;
-
-    case FFESTR_otherNEQV:
-      e->u.operator.op = FFEEXPR_operatorNEQV_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceNEQV_;
-      e->u.operator.as = FFEEXPR_operatorassociativityNEQV_;
-      break;
-
-    case FFESTR_otherLT:
-      e->u.operator.op = FFEEXPR_operatorLT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceLT_;
-      e->u.operator.as = FFEEXPR_operatorassociativityLT_;
-      break;
-
-    case FFESTR_otherLE:
-      e->u.operator.op = FFEEXPR_operatorLE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceLE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityLE_;
-      break;
-
-    case FFESTR_otherEQ:
-      e->u.operator.op = FFEEXPR_operatorEQ_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
-      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
-      break;
-
-    case FFESTR_otherNE:
-      e->u.operator.op = FFEEXPR_operatorNE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceNE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityNE_;
-      break;
-
-    case FFESTR_otherGT:
-      e->u.operator.op = FFEEXPR_operatorGT_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceGT_;
-      e->u.operator.as = FFEEXPR_operatorassociativityGT_;
-      break;
-
-    case FFESTR_otherGE:
-      e->u.operator.op = FFEEXPR_operatorGE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceGE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityGE_;
-      break;
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_INVALID_DOTDOT))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
-	  ffebad_finish ();
-	}
-      e->u.operator.op = FFEEXPR_operatorEQ_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceEQ_;
-      e->u.operator.as = FFEEXPR_operatorassociativityEQ_;
-      break;
-    }
-
-  ffeexpr_exprstack_push_binary_ (e);
-
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    {
-      if (ffest_ffebad_start (FFEBAD_INSERTING_PERIOD))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_tokens_[1]);	/* Kill dot-dot token. */
-      return (ffelexHandler) ffeexpr_token_rhs_ (t);
-    }
-
-  ffelex_token_kill (ffeexpr_tokens_[1]);	/* Kill dot-dot token. */
-  return (ffelexHandler) ffeexpr_token_rhs_;
-}
-
-/* ffeexpr_token_binary_sw_per_ -- Rhs PERIOD NAME(NOT, TRUE, or FALSE)
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   A diagnostic has already been issued; just swallow a period if there is
-   one, then continue with ffeexpr_token_binary_.  */
-
-static ffelexHandler
-ffeexpr_token_binary_sw_per_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) != FFELEX_typePERIOD)
-    return (ffelexHandler) ffeexpr_token_binary_ (t);
-
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_quote_ -- Rhs QUOTE
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Expecting a NUMBER that we'll treat as an octal integer.  */
-
-static ffelexHandler
-ffeexpr_token_quote_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffebld anyexpr;
-
-  if (ffelex_token_type (t) != FFELEX_typeNUMBER)
-    {
-      if (ffest_ffebad_start (FFEBAD_QUOTE_MISSES_DIGITS))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      return (ffelexHandler) ffeexpr_token_rhs_ (t);
-    }
-
-  /* This is kind of a kludge to prevent any whining about magical numbers
-     that start out as these octal integers, so "20000000000 (on a 32-bit
-     2's-complement machine) by itself won't produce an error. */
-
-  anyexpr = ffebld_new_any ();
-  ffebld_set_info (anyexpr, ffeinfo_new_any ());
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_tokens_[0];
-  e->u.operand = ffebld_new_conter_with_orig
-    (ffebld_constant_new_integeroctal (t), anyexpr);
-  ffebld_set_info (e->u.operand, ffeinfo_new (FFEINFO_basictypeINTEGER,
-		      FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindENTITY,
-		       FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-  ffeexpr_exprstack_push_operand_ (e);
-  return (ffelexHandler) ffeexpr_token_binary_;
-}
-
-/* ffeexpr_token_apostrophe_ -- Rhs APOSTROPHE
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle an open-apostrophe, which begins either a character ('char-const'),
-   typeless octal ('octal-const'O), or typeless hexadecimal ('hex-const'Z or
-   'hex-const'X) constant.  */
-
-static ffelexHandler
-ffeexpr_token_apostrophe_ (ffelexToken t)
-{
-  assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
-  if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
-    {
-      ffebad_start (FFEBAD_NULL_CHAR_CONST);
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-  ffeexpr_tokens_[1] = ffelex_token_use (t);
-  return (ffelexHandler) ffeexpr_token_apos_char_;
-}
-
-/* ffeexpr_token_apos_char_ -- Rhs APOSTROPHE CHARACTER
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Close-apostrophe is implicit; if this token is NAME, it is a possible
-   typeless-constant radix specifier.  */
-
-static ffelexHandler
-ffeexpr_token_apos_char_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffeinfo ni;
-  char c;
-  ffetargetCharacterSize size;
-
-  if ((ffelex_token_type (t) == FFELEX_typeNAME)
-      || (ffelex_token_type (t) == FFELEX_typeNAMES))
-    {
-      if ((ffelex_token_length (t) == 1)
-	  && (ffesrc_char_match_init ((c = ffelex_token_text (t)[0]), 'B',
-				      'b')
-	      || ffesrc_char_match_init (c, 'O', 'o')
-	      || ffesrc_char_match_init (c, 'X', 'x')
-	      || ffesrc_char_match_init (c, 'Z', 'z')))
-	{
-	  e = ffeexpr_expr_new_ ();
-	  e->type = FFEEXPR_exprtypeOPERAND_;
-	  e->token = ffeexpr_tokens_[0];
-	  switch (c)
-	    {
-	    case FFESRC_CASE_MATCH_INIT ('B', 'b', match_b, no_match):
-	      e->u.operand = ffebld_new_conter
-		(ffebld_constant_new_typeless_bv (ffeexpr_tokens_[1]));
-	      size = ffetarget_size_typeless_binary (ffeexpr_tokens_[1]);
-	      break;
-
-	    case FFESRC_CASE_MATCH_INIT ('O', 'o', match_o, no_match):
-	      e->u.operand = ffebld_new_conter
-		(ffebld_constant_new_typeless_ov (ffeexpr_tokens_[1]));
-	      size = ffetarget_size_typeless_octal (ffeexpr_tokens_[1]);
-	      break;
-
-	    case FFESRC_CASE_MATCH_INIT ('X', 'x', match_x, no_match):
-	      e->u.operand = ffebld_new_conter
-		(ffebld_constant_new_typeless_hxv (ffeexpr_tokens_[1]));
-	      size = ffetarget_size_typeless_hex (ffeexpr_tokens_[1]);
-	      break;
-
-	    case FFESRC_CASE_MATCH_INIT ('Z', 'z', match_z, no_match):
-	      e->u.operand = ffebld_new_conter
-		(ffebld_constant_new_typeless_hzv (ffeexpr_tokens_[1]));
-	      size = ffetarget_size_typeless_hex (ffeexpr_tokens_[1]);
-	      break;
-
-	    default:
-	    no_match:		/* :::::::::::::::::::: */
-	      assert ("not BOXZ!" == NULL);
-	      size = 0;
-	      break;
-	    }
-	  ffebld_set_info (e->u.operand,
-	       ffeinfo_new (FFEINFO_basictypeTYPELESS, FFEINFO_kindtypeNONE,
-		       0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, size));
-	  ffeexpr_exprstack_push_operand_ (e);
-	  ffelex_token_kill (ffeexpr_tokens_[1]);
-	  return (ffelexHandler) ffeexpr_token_binary_;
-	}
-    }
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_tokens_[0];
-  e->u.operand = ffebld_new_conter (ffebld_constant_new_characterdefault
-				    (ffeexpr_tokens_[1]));
-  ni = ffeinfo_new (FFEINFO_basictypeCHARACTER, FFEINFO_kindtypeCHARACTERDEFAULT,
-		    0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
-		    ffelex_token_length (ffeexpr_tokens_[1]));
-  ffebld_set_info (e->u.operand, ni);
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffeexpr_exprstack_push_operand_ (e);
-  if ((ffelex_token_type (t) == FFELEX_typeNAME)
-      || (ffelex_token_type (t) == FFELEX_typeNAMES))
-    {
-      if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
-	{
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_finish ();
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeBINARY_;
-      e->token = ffelex_token_use (t);
-      e->u.operator.op = FFEEXPR_operatorCONCATENATE_;
-      e->u.operator.prec = FFEEXPR_operatorprecedenceCONCATENATE_;
-      e->u.operator.as = FFEEXPR_operatorassociativityCONCATENATE_;
-      ffeexpr_exprstack_push_binary_ (e);
-      return (ffelexHandler) ffeexpr_token_rhs_ (t);
-    }
-  ffeexpr_is_substr_ok_ = !ffe_is_pedantic_not_90 ();	/* Allow "'hello'(3:5)". */
-  return (ffelexHandler) ffeexpr_token_substrp_ (t);
-}
-
-/* ffeexpr_token_name_lhs_ -- Lhs NAME
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle a name followed by open-paren, period (RECORD.MEMBER), percent
-   (RECORD%MEMBER), or nothing at all.	*/
-
-static ffelexHandler
-ffeexpr_token_name_lhs_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffeexprParenType_ paren_type;
-  ffesymbol s;
-  ffebld expr;
-  ffeinfo info;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextASSIGN:
-	case FFEEXPR_contextAGOTO:
-	case FFEEXPR_contextFILEUNIT_DF:
-	  goto just_name;	/* :::::::::::::::::::: */
-
-	default:
-	  break;
-	}
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->token = ffelex_token_use (ffeexpr_tokens_[0]);
-      s = ffeexpr_declare_parenthesized_ (ffeexpr_tokens_[0], FALSE,
-					  &paren_type);
-
-      switch (ffesymbol_where (s))
-	{
-	case FFEINFO_whereLOCAL:
-	  if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
-	    ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Recursion. */
-	  break;
-
-	case FFEINFO_whereINTRINSIC:
-	case FFEINFO_whereGLOBAL:
-	  if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
-	    ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Can call intrin. */
-	  break;
-
-	case FFEINFO_whereCOMMON:
-	case FFEINFO_whereDUMMY:
-	case FFEINFO_whereRESULT:
-	  break;
-
-	case FFEINFO_whereNONE:
-	case FFEINFO_whereANY:
-	  break;
-
-	default:
-	  ffesymbol_error (s, ffeexpr_tokens_[0]);
-	  break;
-	}
-
-      if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
-	{
-	  e->u.operand = ffebld_new_any ();
-	  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-	}
-      else
-	{
-	  e->u.operand = ffebld_new_symter (s,
-					    ffesymbol_generic (s),
-					    ffesymbol_specific (s),
-					    ffesymbol_implementation (s));
-	  ffebld_set_info (e->u.operand, ffesymbol_info (s));
-	}
-      ffeexpr_exprstack_push_ (e);	/* Not a complete operand yet. */
-      ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
-      switch (paren_type)
-	{
-	case FFEEXPR_parentypeSUBROUTINE_:
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 FFEEXPR_contextACTUALARG_,
-			 ffeexpr_token_arguments_);
-
-	case FFEEXPR_parentypeARRAY_:
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  ffeexpr_stack_->bound_list = ffesymbol_dims (s);
-	  ffeexpr_stack_->rank = 0;
-	  ffeexpr_stack_->constant = TRUE;
-	  ffeexpr_stack_->immediate = TRUE;
-	  switch (ffeexpr_stack_->context)
-	    {
-	    case FFEEXPR_contextDATAIMPDOITEM_:
-	      return
-		(ffelexHandler)
-		ffeexpr_rhs (ffeexpr_stack_->pool,
-			     FFEEXPR_contextDATAIMPDOINDEX_,
-			     ffeexpr_token_elements_);
-
-	    case FFEEXPR_contextEQUIVALENCE:
-	      return
-		(ffelexHandler)
-		ffeexpr_rhs (ffeexpr_stack_->pool,
-			     FFEEXPR_contextEQVINDEX_,
-			     ffeexpr_token_elements_);
-
-	    default:
-	      return
-		(ffelexHandler)
-		ffeexpr_rhs (ffeexpr_stack_->pool,
-			     FFEEXPR_contextINDEX_,
-			     ffeexpr_token_elements_);
-	    }
-
-	case FFEEXPR_parentypeSUBSTRING_:
-	  e->u.operand = ffeexpr_collapse_symter (e->u.operand,
-						  ffeexpr_tokens_[0]);
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 FFEEXPR_contextINDEX_,
-			 ffeexpr_token_substring_);
-
-	case FFEEXPR_parentypeEQUIVALENCE_:
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  ffeexpr_stack_->bound_list = ffesymbol_dims (s);
-	  ffeexpr_stack_->rank = 0;
-	  ffeexpr_stack_->constant = TRUE;
-	  ffeexpr_stack_->immediate = TRUE;
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 FFEEXPR_contextEQVINDEX_,
-			 ffeexpr_token_equivalence_);
-
-	case FFEEXPR_parentypeFUNCTION_:	/* Invalid case. */
-	case FFEEXPR_parentypeFUNSUBSTR_:	/* Invalid case. */
-	  ffesymbol_error (s, ffeexpr_tokens_[0]);
-	  /* Fall through. */
-	case FFEEXPR_parentypeANY_:
-	  e->u.operand = ffebld_new_any ();
-	  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 FFEEXPR_contextACTUALARG_,
-			 ffeexpr_token_anything_);
-
-	default:
-	  assert ("bad paren type" == NULL);
-	  break;
-	}
-
-    case FFELEX_typeEQUALS:	/* As in "VAR=". */
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextIMPDOITEM_:	/* within
-						   "(,VAR=start,end[,incr])". */
-	case FFEEXPR_contextIMPDOITEMDF_:
-	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
-	  break;
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  ffeexpr_stack_->context = FFEEXPR_contextDATAIMPDOCTRL_;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-#if 0
-    case FFELEX_typePERIOD:
-    case FFELEX_typePERCENT:
-      assert ("FOO%, FOO. not yet supported!~~" == NULL);
-      break;
-#endif
-
-    default:
-      break;
-    }
-
-just_name:			/* :::::::::::::::::::: */
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_tokens_[0];
-  s = ffeexpr_declare_unadorned_ (ffeexpr_tokens_[0],
-				  (ffeexpr_stack_->context
-				   == FFEEXPR_contextSUBROUTINEREF));
-
-  switch (ffesymbol_where (s))
-    {
-    case FFEINFO_whereCONSTANT:
-      if ((ffeexpr_stack_->context != FFEEXPR_contextPARAMETER)
-	  || (ffesymbol_kind (s) != FFEINFO_kindENTITY))
-	ffesymbol_error (s, ffeexpr_tokens_[0]);
-      break;
-
-    case FFEINFO_whereIMMEDIATE:
-      if ((ffeexpr_stack_->context != FFEEXPR_contextDATAIMPDOCTRL_)
-	  && (ffeexpr_stack_->context != FFEEXPR_contextDATAIMPDOINDEX_))
-	ffesymbol_error (s, ffeexpr_tokens_[0]);
-      break;
-
-    case FFEINFO_whereLOCAL:
-      if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
-	ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Recurse!. */
-      break;
-
-    case FFEINFO_whereINTRINSIC:
-      if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
-	ffesymbol_error (s, ffeexpr_tokens_[0]);	/* Can call intrin. */
-      break;
-
-    default:
-      break;
-    }
-
-  if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
-    {
-      expr = ffebld_new_any ();
-      info = ffeinfo_new_any ();
-      ffebld_set_info (expr, info);
-    }
-  else
-    {
-      expr = ffebld_new_symter (s,
-				ffesymbol_generic (s),
-				ffesymbol_specific (s),
-				ffesymbol_implementation (s));
-      info = ffesymbol_info (s);
-      ffebld_set_info (expr, info);
-      if (ffesymbol_is_doiter (s))
-	{
-	  ffebad_start (FFEBAD_DOITER);
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffest_ffebad_here_doiter (1, s);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_finish ();
-	}
-      expr = ffeexpr_collapse_symter (expr, ffeexpr_tokens_[0]);
-    }
-
-  if (ffeexpr_stack_->context == FFEEXPR_contextSUBROUTINEREF)
-    {
-      if (ffebld_op (expr) == FFEBLD_opANY)
-	{
-	  expr = ffebld_new_any ();
-	  ffebld_set_info (expr, ffeinfo_new_any ());
-	}
-      else
-	{
-	  expr = ffebld_new_subrref (expr, NULL);	/* No argument list. */
-	  if (ffesymbol_generic (s) != FFEINTRIN_genNONE)
-	    ffeintrin_fulfill_generic (&expr, &info, e->token);
-	  else if (ffesymbol_specific (s) != FFEINTRIN_specNONE)
-	    ffeintrin_fulfill_specific (&expr, &info, NULL, e->token);
-	  else
-	    ffeexpr_fulfill_call_ (&expr, e->token);
-
-	  if (ffebld_op (expr) != FFEBLD_opANY)
-	    ffebld_set_info (expr,
-			     ffeinfo_new (ffeinfo_basictype (info),
-					  ffeinfo_kindtype (info),
-					  0,
-					  FFEINFO_kindENTITY,
-					  FFEINFO_whereFLEETING,
-					  ffeinfo_size (info)));
-	  else
-	    ffebld_set_info (expr, ffeinfo_new_any ());
-	}
-    }
-
-  e->u.operand = expr;
-  ffeexpr_exprstack_push_operand_ (e);
-  return (ffelexHandler) ffeexpr_finished_ (t);
-}
-
-/* ffeexpr_token_name_arg_ -- Rhs NAME
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle first token in an actual-arg (or possible actual-arg) context
-   being a NAME, and use second token to refine the context.  */
-
-static ffelexHandler
-ffeexpr_token_name_arg_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-    case FFELEX_typeCOMMA:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARG_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARG_;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    default:
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextINDEXORACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  ffeexpr_stack_->context = FFEEXPR_contextSFUNCDEFACTUALARGEXPR_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  ffeexpr_stack_->context
-	    = FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_;
-	  break;
-
-	default:
-	  assert ("bad context in _name_arg_" == NULL);
-	  break;
-	}
-      break;
-    }
-
-  return (ffelexHandler) ffeexpr_token_name_rhs_ (t);
-}
-
-/* ffeexpr_token_name_rhs_ -- Rhs NAME
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle a name followed by open-paren, apostrophe (O'octal-const',
-   Z'hex-const', or X'hex-const'), period (RECORD.MEMBER).
-
-   26-Nov-91  JCB  1.2
-      When followed by apostrophe or quote, set lex hexnum flag on so
-      [0-9] as first char of next token seen as starting a potentially
-      hex number (NAME).
-   04-Oct-91  JCB  1.1
-      In case of intrinsic, decorate its SYMTER with the type info for
-      the specific intrinsic.  */
-
-static ffelexHandler
-ffeexpr_token_name_rhs_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  ffeexprParenType_ paren_type;
-  ffesymbol s;
-  bool sfdef;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeQUOTE:
-    case FFELEX_typeAPOSTROPHE:
-      ffeexpr_tokens_[1] = ffelex_token_use (t);
-      ffelex_set_hexnum (TRUE);
-      return (ffelexHandler) ffeexpr_token_name_apos_;
-
-    case FFELEX_typeOPEN_PAREN:
-      e = ffeexpr_expr_new_ ();
-      e->type = FFEEXPR_exprtypeOPERAND_;
-      e->token = ffelex_token_use (ffeexpr_tokens_[0]);
-      s = ffeexpr_declare_parenthesized_ (ffeexpr_tokens_[0], TRUE,
-					  &paren_type);
-      if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
-	e->u.operand = ffebld_new_any ();
-      else
-	e->u.operand = ffebld_new_symter (s, ffesymbol_generic (s),
-					  ffesymbol_specific (s),
-					  ffesymbol_implementation (s));
-      ffeexpr_exprstack_push_ (e);	/* Not a complete operand yet. */
-      ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	  sfdef = TRUE;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  assert ("weird context!" == NULL);
-	  sfdef = FALSE;
-	  break;
-
-	default:
-	  sfdef = FALSE;
-	  break;
-	}
-      switch (paren_type)
-	{
-	case FFEEXPR_parentypeFUNCTION_:
-	  ffebld_set_info (e->u.operand, ffesymbol_info (s));
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  if (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
-	    {			/* A statement function. */
-	      ffeexpr_stack_->num_args
-		= ffebld_list_length
-		  (ffeexpr_stack_->next_dummy
-		   = ffesymbol_dummyargs (s));
-	      ffeexpr_stack_->tokens[1] = NULL;	/* !=NULL when > num_args. */
-	    }
-	  else if ((ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
-		   && !ffe_is_pedantic_not_90 ()
-		   && ((ffesymbol_implementation (s)
-			== FFEINTRIN_impICHAR)
-		       || (ffesymbol_implementation (s)
-			   == FFEINTRIN_impIACHAR)
-		       || (ffesymbol_implementation (s)
-			   == FFEINTRIN_impLEN)))
-	    {			/* Allow arbitrary concatenations. */
-	      return
-		(ffelexHandler)
-		  ffeexpr_rhs (ffeexpr_stack_->pool,
-			       sfdef
-			       ? FFEEXPR_contextSFUNCDEF
-			       : FFEEXPR_contextLET,
-			       ffeexpr_token_arguments_);
-	    }
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 sfdef
-			 ? FFEEXPR_contextSFUNCDEFACTUALARG_
-			 : FFEEXPR_contextACTUALARG_,
-			 ffeexpr_token_arguments_);
-
-	case FFEEXPR_parentypeARRAY_:
-	  ffebld_set_info (e->u.operand,
-			   ffesymbol_info (ffebld_symter (e->u.operand)));
-	  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-	  ffeexpr_stack_->bound_list = ffesymbol_dims (s);
-	  ffeexpr_stack_->rank = 0;
-	  ffeexpr_stack_->constant = TRUE;
-	  ffeexpr_stack_->immediate = TRUE;
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      sfdef
-					      ? FFEEXPR_contextSFUNCDEFINDEX_
-					      : FFEEXPR_contextINDEX_,
-					      ffeexpr_token_elements_);
-
-	case FFEEXPR_parentypeSUBSTRING_:
-	  ffebld_set_info (e->u.operand,
-			   ffesymbol_info (ffebld_symter (e->u.operand)));
-	  e->u.operand = ffeexpr_collapse_symter (e->u.operand,
-						  ffeexpr_tokens_[0]);
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 sfdef
-			 ? FFEEXPR_contextSFUNCDEFINDEX_
-			 : FFEEXPR_contextINDEX_,
-			 ffeexpr_token_substring_);
-
-	case FFEEXPR_parentypeFUNSUBSTR_:
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 sfdef
-			 ? FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_
-			 : FFEEXPR_contextINDEXORACTUALARG_,
-			 ffeexpr_token_funsubstr_);
-
-	case FFEEXPR_parentypeANY_:
-	  ffebld_set_info (e->u.operand, ffesymbol_info (s));
-	  return
-	    (ffelexHandler)
-	    ffeexpr_rhs (ffeexpr_stack_->pool,
-			 sfdef
-			 ? FFEEXPR_contextSFUNCDEFACTUALARG_
-			 : FFEEXPR_contextACTUALARG_,
-			 ffeexpr_token_anything_);
-
-	default:
-	  assert ("bad paren type" == NULL);
-	  break;
-	}
-
-    case FFELEX_typeEQUALS:	/* As in "VAR=". */
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextIMPDOITEM_:	/* "(,VAR=start,end[,incr])". */
-	case FFEEXPR_contextIMPDOITEMDF_:
-	  ffeexpr_stack_->is_rhs = FALSE;	/* Really an lhs construct. */
-	  ffeexpr_stack_->context = FFEEXPR_contextIMPDOCTRL_;
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-#if 0
-    case FFELEX_typePERIOD:
-    case FFELEX_typePERCENT:
-      ~~Support these two someday, though not required
-	assert ("FOO%, FOO. not yet supported!~~" == NULL);
-      break;
-#endif
-
-    default:
-      break;
-    }
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextINDEXORACTUALARG_:
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-      assert ("strange context" == NULL);
-      break;
-
-    default:
-      break;
-    }
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_tokens_[0];
-  s = ffeexpr_declare_unadorned_ (ffeexpr_tokens_[0], FALSE);
-  if (ffesymbol_attrs (s) & FFESYMBOL_attrsANY)
-    {
-      e->u.operand = ffebld_new_any ();
-      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-    }
-  else
-    {
-      e->u.operand = ffebld_new_symter (s, FFEINTRIN_genNONE,
-					ffesymbol_specific (s),
-					ffesymbol_implementation (s));
-      if (ffesymbol_specific (s) == FFEINTRIN_specNONE)
-	ffebld_set_info (e->u.operand, ffeinfo_use (ffesymbol_info (s)));
-      else
-	{			/* Decorate the SYMTER with the actual type
-				   of the intrinsic. */
-	  ffebld_set_info (e->u.operand, ffeinfo_new
-			(ffeintrin_basictype (ffesymbol_specific (s)),
-			 ffeintrin_kindtype (ffesymbol_specific (s)),
-			 0,
-			 ffesymbol_kind (s),
-			 ffesymbol_where (s),
-			 FFETARGET_charactersizeNONE));
-	}
-      if (ffesymbol_is_doiter (s))
-	ffebld_symter_set_is_doiter (e->u.operand, TRUE);
-      e->u.operand = ffeexpr_collapse_symter (e->u.operand,
-					      ffeexpr_tokens_[0]);
-    }
-  ffeexpr_exprstack_push_operand_ (e);
-  return (ffelexHandler) ffeexpr_token_binary_ (t);
-}
-
-/* ffeexpr_token_name_apos_ -- Rhs NAME APOSTROPHE
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Expecting a NAME token, analyze the previous NAME token to see what kind,
-   if any, typeless constant we've got.
-
-   01-Sep-90  JCB  1.1
-      Expect a NAME instead of CHARACTER in this situation.  */
-
-static ffelexHandler
-ffeexpr_token_name_apos_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-
-  ffelex_set_hexnum (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffeexpr_tokens_[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_name_apos_name_;
-
-    default:
-      break;
-    }
-
-  if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
-    {
-      ffebad_string (ffelex_token_text (ffeexpr_tokens_[0]));
-      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		   ffelex_token_where_column (ffeexpr_tokens_[0]));
-      ffebad_here (1, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->u.operand = ffebld_new_any ();
-  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-  e->token = ffeexpr_tokens_[0];
-  ffeexpr_exprstack_push_operand_ (e);
-
-  return (ffelexHandler) ffeexpr_token_binary_ (t);
-}
-
-/* ffeexpr_token_name_apos_name_ -- Rhs NAME APOSTROPHE NAME
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Expecting an APOSTROPHE token, analyze the previous NAME token to see
-   what kind, if any, typeless constant we've got.  */
-
-static ffelexHandler
-ffeexpr_token_name_apos_name_ (ffelexToken t)
-{
-  ffeexprExpr_ e;
-  char c;
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->token = ffeexpr_tokens_[0];
-
-  if ((ffelex_token_type (t) == ffelex_token_type (ffeexpr_tokens_[1]))
-      && (ffelex_token_length (ffeexpr_tokens_[0]) == 1)
-      && (ffesrc_char_match_init ((c = ffelex_token_text (ffeexpr_tokens_[0])[0]),
-				  'B', 'b')
-	  || ffesrc_char_match_init (c, 'O', 'o')
-	  || ffesrc_char_match_init (c, 'X', 'x')
-	  || ffesrc_char_match_init (c, 'Z', 'z')))
-    {
-      ffetargetCharacterSize size;
-
-      if (!ffe_is_typeless_boz ()) {
-
-      switch (c)
-	{
-	case FFESRC_CASE_MATCH_INIT ('B', 'b', imatch_b, no_imatch):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integerbinary
-					    (ffeexpr_tokens_[2]));
-	  break;
-
-	case FFESRC_CASE_MATCH_INIT ('O', 'o', imatch_o, no_imatch):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integeroctal
-					    (ffeexpr_tokens_[2]));
-	  break;
-
-	case FFESRC_CASE_MATCH_INIT ('X', 'x', imatch_x, no_imatch):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integerhex
-					    (ffeexpr_tokens_[2]));
-	  break;
-
-	case FFESRC_CASE_MATCH_INIT ('Z', 'z', imatch_z, no_imatch):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_integerhex
-					    (ffeexpr_tokens_[2]));
-	  break;
-
-	default:
-	no_imatch:		/* :::::::::::::::::::: */
-	  assert ("not BOXZ!" == NULL);
-	  abort ();
-	}
-
-	ffebld_set_info (e->u.operand,
-			 ffeinfo_new (FFEINFO_basictypeINTEGER,
-				      FFEINFO_kindtypeINTEGERDEFAULT, 0,
-				      FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
-				      FFETARGET_charactersizeNONE));
-	ffeexpr_exprstack_push_operand_ (e);
-	ffelex_token_kill (ffeexpr_tokens_[1]);
-	ffelex_token_kill (ffeexpr_tokens_[2]);
-	return (ffelexHandler) ffeexpr_token_binary_;
-      }
-
-      switch (c)
-	{
-	case FFESRC_CASE_MATCH_INIT ('B', 'b', match_b, no_match):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_bm
-					    (ffeexpr_tokens_[2]));
-	  size = ffetarget_size_typeless_binary (ffeexpr_tokens_[2]);
-	  break;
-
-	case FFESRC_CASE_MATCH_INIT ('O', 'o', match_o, no_match):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_om
-					    (ffeexpr_tokens_[2]));
-	  size = ffetarget_size_typeless_octal (ffeexpr_tokens_[2]);
-	  break;
-
-	case FFESRC_CASE_MATCH_INIT ('X', 'x', match_x, no_match):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hxm
-					    (ffeexpr_tokens_[2]));
-	  size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
-	  break;
-
-	case FFESRC_CASE_MATCH_INIT ('Z', 'z', match_z, no_match):
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hzm
-					    (ffeexpr_tokens_[2]));
-	  size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
-	  break;
-
-	default:
-	no_match:		/* :::::::::::::::::::: */
-	  assert ("not BOXZ!" == NULL);
-	  e->u.operand = ffebld_new_conter (ffebld_constant_new_typeless_hzm
-					    (ffeexpr_tokens_[2]));
-	  size = ffetarget_size_typeless_hex (ffeexpr_tokens_[2]);
-	  break;
-	}
-      ffebld_set_info (e->u.operand,
-	       ffeinfo_new (FFEINFO_basictypeTYPELESS, FFEINFO_kindtypeNONE,
-		       0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, size));
-      ffeexpr_exprstack_push_operand_ (e);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[2]);
-      return (ffelexHandler) ffeexpr_token_binary_;
-    }
-
-  if (ffest_ffebad_start (FFEBAD_INVALID_RADIX_SPECIFIER))
-    {
-      ffebad_string (ffelex_token_text (ffeexpr_tokens_[0]));
-      ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		   ffelex_token_where_column (ffeexpr_tokens_[0]));
-      ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  ffelex_token_kill (ffeexpr_tokens_[1]);
-  ffelex_token_kill (ffeexpr_tokens_[2]);
-
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  e->u.operand = ffebld_new_any ();
-  ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-  e->token = ffeexpr_tokens_[0];
-  ffeexpr_exprstack_push_operand_ (e);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeAPOSTROPHE:
-    case FFELEX_typeQUOTE:
-      return (ffelexHandler) ffeexpr_token_binary_;
-
-    default:
-      return (ffelexHandler) ffeexpr_token_binary_ (t);
-    }
-}
-
-/* ffeexpr_token_percent_ -- Rhs PERCENT
-
-   Handle a percent sign possibly followed by "LOC".  If followed instead
-   by "VAL", "REF", or "DESCR", issue an error message and substitute
-   "LOC".  If followed by something else, treat the percent sign as a
-   spurious incorrect token and reprocess the token via _rhs_.	*/
-
-static ffelexHandler
-ffeexpr_token_percent_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffeexpr_stack_->percent = ffeexpr_percent_ (t);
-      ffeexpr_tokens_[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_token_percent_name_;
-
-    default:
-      if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      return (ffelexHandler) ffeexpr_token_rhs_ (t);
-    }
-}
-
-/* ffeexpr_token_percent_name_ -- Rhs PERCENT NAME
-
-   Make sure the token is OPEN_PAREN and prepare for the one-item list of
-   LHS expressions.  Else display an error message.  */
-
-static ffelexHandler
-ffeexpr_token_percent_name_ (ffelexToken t)
-{
-  ffelexHandler nexthandler;
-
-  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
-    {
-      if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->first_token),
-		   ffelex_token_where_column (ffeexpr_stack_->first_token));
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_tokens_[0]);
-      nexthandler = (ffelexHandler) ffeexpr_token_rhs_ (ffeexpr_tokens_[1]);
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      return (ffelexHandler) (*nexthandler) (t);
-    }
-
-  switch (ffeexpr_stack_->percent)
-    {
-    default:
-      if (ffest_ffebad_start (FFEBAD_INVALID_PERCENT))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_tokens_[0]),
-		       ffelex_token_where_column (ffeexpr_tokens_[0]));
-	  ffebad_string (ffelex_token_text (ffeexpr_tokens_[1]));
-	  ffebad_finish ();
-	}
-      ffeexpr_stack_->percent = FFEEXPR_percentLOC_;
-      /* Fall through. */
-    case FFEEXPR_percentLOC_:
-      ffeexpr_stack_->tokens[0] = ffeexpr_tokens_[0];
-      ffelex_token_kill (ffeexpr_tokens_[1]);
-      ffeexpr_stack_->tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  FFEEXPR_contextLOC_,
-					  ffeexpr_cb_end_loc_);
-    }
-}
-
-/* ffeexpr_make_float_const_ -- Make a floating-point constant
-
-   See prototype.
-
-   Pass 'E', 'D', or 'Q' for exponent letter.  */
-
-static void
-ffeexpr_make_float_const_ (char exp_letter, ffelexToken integer,
-			   ffelexToken decimal, ffelexToken fraction,
-			   ffelexToken exponent, ffelexToken exponent_sign,
-			   ffelexToken exponent_digits)
-{
-  ffeexprExpr_ e;
-
-  e = ffeexpr_expr_new_ ();
-  e->type = FFEEXPR_exprtypeOPERAND_;
-  if (integer != NULL)
-    e->token = ffelex_token_use (integer);
-  else
-    {
-      assert (decimal != NULL);
-      e->token = ffelex_token_use (decimal);
-    }
-
-  switch (exp_letter)
-    {
-#if !FFETARGET_okREALQUAD
-    case FFESRC_CASE_MATCH_INIT ('Q', 'q', match_q, no_match):
-      if (ffebad_start (FFEBAD_QUAD_UNSUPPORTED))
-	{
-	  ffebad_here (0, ffelex_token_where_line (e->token),
-		       ffelex_token_where_column (e->token));
-	  ffebad_finish ();
-	}
-      goto match_d;		/* The FFESRC_CASE_* macros don't
-				   allow fall-through! */
-#endif
-
-    case FFESRC_CASE_MATCH_INIT ('D', 'd', match_d, no_match):
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_realdouble
-					(integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
-      ffebld_set_info (e->u.operand,
-	     ffeinfo_new (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALDOUBLE,
-			  0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-      break;
-
-    case FFESRC_CASE_MATCH_INIT ('E', 'e', match_e, no_match):
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_realdefault
-					(integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
-      ffebld_set_info (e->u.operand, ffeinfo_new (FFEINFO_basictypeREAL,
-			 FFEINFO_kindtypeREALDEFAULT, 0, FFEINFO_kindENTITY,
-		       FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-      break;
-
-#if FFETARGET_okREALQUAD
-    case FFESRC_CASE_MATCH_INIT ('Q', 'q', match_q, no_match):
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_realquad
-					(integer, decimal, fraction, exponent, exponent_sign, exponent_digits));
-      ffebld_set_info (e->u.operand,
-	       ffeinfo_new (FFEINFO_basictypeREAL, FFEINFO_kindtypeREALQUAD,
-			    0, FFEINFO_kindENTITY, FFEINFO_whereCONSTANT, FFETARGET_charactersizeNONE));
-      break;
-#endif
-
-    case 'I':	/* Make an integer. */
-      e->u.operand = ffebld_new_conter (ffebld_constant_new_integerdefault
-					(ffeexpr_tokens_[0]));
-      ffebld_set_info (e->u.operand,
-		       ffeinfo_new (FFEINFO_basictypeINTEGER,
-				    FFEINFO_kindtypeINTEGERDEFAULT, 0,
-				    FFEINFO_kindENTITY, FFEINFO_whereCONSTANT,
-				    FFETARGET_charactersizeNONE));
-      break;
-
-    default:
-    no_match:			/* :::::::::::::::::::: */
-      assert ("Lost the exponent letter!" == NULL);
-    }
-
-  ffeexpr_exprstack_push_operand_ (e);
-}
-
-/* Just like ffesymbol_declare_local, except performs any implicit info
-   assignment necessary.  */
-
-static ffesymbol
-ffeexpr_declare_unadorned_ (ffelexToken t, bool maybe_intrin)
-{
-  ffesymbol s;
-  ffeinfoKind k;
-  bool bad;
-
-  s = ffesymbol_declare_local (t, maybe_intrin);
-
-  switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-    /* Special-case these since they can involve a different concept
-       of "state" (in the stmtfunc name space).  */
-    {
-    case FFEEXPR_contextDATAIMPDOINDEX_:
-    case FFEEXPR_contextDATAIMPDOCTRL_:
-      if (ffeexpr_context_outer_ (ffeexpr_stack_)
-	  == FFEEXPR_contextDATAIMPDOINDEX_)
-	s = ffeexpr_sym_impdoitem_ (s, t);
-      else
-	if (ffeexpr_stack_->is_rhs)
-	  s = ffeexpr_sym_impdoitem_ (s, t);
-	else
-	  s = ffeexpr_sym_lhs_impdoctrl_ (s, t);
-      bad = (ffesymbol_kind (s) != FFEINFO_kindENTITY)
-	|| ((ffesymbol_where (s) != FFEINFO_whereCONSTANT)
-	    && (ffesymbol_where (s) != FFEINFO_whereIMMEDIATE));
-      if (bad && (ffesymbol_kind (s) != FFEINFO_kindANY))
-	ffesymbol_error (s, t);
-      return s;
-
-    default:
-      break;
-    }
-
-  switch ((ffesymbol_sfdummyparent (s) == NULL)
-	  ? ffesymbol_state (s)
-	  : FFESYMBOL_stateUNDERSTOOD)
-    {
-    case FFESYMBOL_stateNONE:	/* Before first exec, not seen in expr
-				   context. */
-      if (!ffest_seen_first_exec ())
-	goto seen;		/* :::::::::::::::::::: */
-      /* Fall through. */
-    case FFESYMBOL_stateUNCERTAIN:	/* Unseen since first exec. */
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextSUBROUTINEREF:
-	  s = ffeexpr_sym_lhs_call_ (s, t);
-	  break;
-
-	case FFEEXPR_contextFILEEXTFUNC:
-	  s = ffeexpr_sym_lhs_extfunc_ (s, t);
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  /* Fall through. */
-	case FFEEXPR_contextACTUALARG_:
-	  s = ffeexpr_sym_rhs_actualarg_ (s, t);
-	  break;
-
-	case FFEEXPR_contextDATA:
-	  if (ffeexpr_stack_->is_rhs)
-	    s = ffeexpr_sym_rhs_let_ (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_data_ (s, t);
-	  break;
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  s = ffeexpr_sym_lhs_data_ (s, t);
-	  break;
-
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  /* Fall through. */
-	case FFEEXPR_contextLET:
-	case FFEEXPR_contextPAREN_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextASSIGN:
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextDO:
-	case FFEEXPR_contextDOWHILE:
-	case FFEEXPR_contextAGOTO:
-	case FFEEXPR_contextCGOTO:
-	case FFEEXPR_contextIF:
-	case FFEEXPR_contextARITHIF:
-	case FFEEXPR_contextFORMAT:
-	case FFEEXPR_contextSTOP:
-	case FFEEXPR_contextRETURN:
-	case FFEEXPR_contextSELECTCASE:
-	case FFEEXPR_contextCASE:
-	case FFEEXPR_contextFILEASSOC:
-	case FFEEXPR_contextFILEINT:
-	case FFEEXPR_contextFILEDFINT:
-	case FFEEXPR_contextFILELOG:
-	case FFEEXPR_contextFILENUM:
-	case FFEEXPR_contextFILENUMAMBIG:
-	case FFEEXPR_contextFILECHAR:
-	case FFEEXPR_contextFILENUMCHAR:
-	case FFEEXPR_contextFILEDFCHAR:
-	case FFEEXPR_contextFILEKEY:
-	case FFEEXPR_contextFILEUNIT:
-	case FFEEXPR_contextFILEUNIT_DF:
-	case FFEEXPR_contextFILEUNITAMBIG:
-	case FFEEXPR_contextFILEFORMAT:
-	case FFEEXPR_contextFILENAMELIST:
-	case FFEEXPR_contextFILEVXTCODE:
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextIMPDOITEM_:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	case FFEEXPR_contextIMPDOCTRL_:
-	case FFEEXPR_contextLOC_:
-	  if (ffeexpr_stack_->is_rhs)
-	    s = ffeexpr_sym_rhs_let_ (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_let_ (s, t);
-	  break;
-
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextEQUIVALENCE:
-	case FFEEXPR_contextINCLUDE:
-	case FFEEXPR_contextPARAMETER:
-	case FFEEXPR_contextDIMLIST:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  break;		/* Will turn into errors below. */
-
-	default:
-	  ffesymbol_error (s, t);
-	  break;
-	}
-      /* Fall through. */
-    case FFESYMBOL_stateUNDERSTOOD:	/* Nothing much more to learn. */
-    understood:		/* :::::::::::::::::::: */
-      k = ffesymbol_kind (s);
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextSUBROUTINEREF:
-	  bad = ((k != FFEINFO_kindSUBROUTINE)
-		 && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
-		     || (k != FFEINFO_kindNONE)));
-	  break;
-
-	case FFEEXPR_contextFILEEXTFUNC:
-	  bad = (k != FFEINFO_kindFUNCTION)
-	    || (ffesymbol_where (s) != FFEINFO_whereGLOBAL);
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextACTUALARG_:
-	  switch (k)
-	    {
-	    case FFEINFO_kindENTITY:
-	      bad = FALSE;
-	      break;
-
-	    case FFEINFO_kindFUNCTION:
-	    case FFEINFO_kindSUBROUTINE:
-	      bad
-		= ((ffesymbol_where (s) != FFEINFO_whereGLOBAL)
-		   && (ffesymbol_where (s) != FFEINFO_whereDUMMY)
-		   && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
-		       || !ffeintrin_is_actualarg (ffesymbol_specific (s))));
-	      break;
-
-	    case FFEINFO_kindNONE:
-	      if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
-		{
-		  bad = !(ffeintrin_is_actualarg (ffesymbol_specific (s)));
-		  break;
-		}
-
-	      /* If state is UNDERSTOOD here, it's CHAR*(*) or attrsANY,
-		 and in the former case, attrsTYPE is set, so we
-		 see this as an error as we should, since CHAR*(*)
-		 cannot be actually referenced in a main/block data
-		 program unit.  */
-
-	      if ((ffesymbol_attrs (s) & (FFESYMBOL_attrsANY
-					  | FFESYMBOL_attrsEXTERNAL
-					  | FFESYMBOL_attrsTYPE))
-		  == FFESYMBOL_attrsEXTERNAL)
-		bad = FALSE;
-	      else
-		bad = TRUE;
-	      break;
-
-	    default:
-	      bad = TRUE;
-	      break;
-	    }
-	  break;
-
-	case FFEEXPR_contextDATA:
-	  if (ffeexpr_stack_->is_rhs)
-	    bad = (k != FFEINFO_kindENTITY)
-	      || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
-	  else
-	    bad = (k != FFEINFO_kindENTITY)
-	      || ((ffesymbol_where (s) != FFEINFO_whereNONE)
-		  && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
-		  && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
-	  break;
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  bad = TRUE;		/* Unadorned item never valid. */
-	  break;
-
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextLET:
-	case FFEEXPR_contextPAREN_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextASSIGN:
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextDO:
-	case FFEEXPR_contextDOWHILE:
-	case FFEEXPR_contextAGOTO:
-	case FFEEXPR_contextCGOTO:
-	case FFEEXPR_contextIF:
-	case FFEEXPR_contextARITHIF:
-	case FFEEXPR_contextFORMAT:
-	case FFEEXPR_contextSTOP:
-	case FFEEXPR_contextRETURN:
-	case FFEEXPR_contextSELECTCASE:
-	case FFEEXPR_contextCASE:
-	case FFEEXPR_contextFILEASSOC:
-	case FFEEXPR_contextFILEINT:
-	case FFEEXPR_contextFILEDFINT:
-	case FFEEXPR_contextFILELOG:
-	case FFEEXPR_contextFILENUM:
-	case FFEEXPR_contextFILENUMAMBIG:
-	case FFEEXPR_contextFILECHAR:
-	case FFEEXPR_contextFILENUMCHAR:
-	case FFEEXPR_contextFILEDFCHAR:
-	case FFEEXPR_contextFILEKEY:
-	case FFEEXPR_contextFILEUNIT:
-	case FFEEXPR_contextFILEUNIT_DF:
-	case FFEEXPR_contextFILEUNITAMBIG:
-	case FFEEXPR_contextFILEFORMAT:
-	case FFEEXPR_contextFILENAMELIST:
-	case FFEEXPR_contextFILEVXTCODE:
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextIMPDOITEM_:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	case FFEEXPR_contextIMPDOCTRL_:
-	case FFEEXPR_contextLOC_:
-	  bad = (k != FFEINFO_kindENTITY);	/* This catches "SUBROUTINE
-						   X(A);EXTERNAL A;CALL
-						   Y(A);B=A", for example. */
-	  break;
-
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextEQUIVALENCE:
-	case FFEEXPR_contextPARAMETER:
-	case FFEEXPR_contextDIMLIST:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  bad = (k != FFEINFO_kindENTITY)
-	    || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
-	  break;
-
-	case FFEEXPR_contextINCLUDE:
-	  bad = TRUE;
-	  break;
-
-	default:
-	  bad = TRUE;
-	  break;
-	}
-      if (bad && (k != FFEINFO_kindANY))
-	ffesymbol_error (s, t);
-      return s;
-
-    case FFESYMBOL_stateSEEN:	/* Seen but not yet in exec portion. */
-    seen:			/* :::::::::::::::::::: */
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextPARAMETER:
-	  if (ffeexpr_stack_->is_rhs)
-	    ffesymbol_error (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_parameter_ (s, t);
-	  break;
-
-	case FFEEXPR_contextDATA:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  if (ffeexpr_stack_->is_rhs)
-	    ffesymbol_error (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_data_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  s = ffeexpr_sym_lhs_data_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	case FFEEXPR_contextEQUIVALENCE:
-	  s = ffeexpr_sym_lhs_equivalence_ (s, t);
-	  break;
-
-	case FFEEXPR_contextDIMLIST:
-	  s = ffeexpr_sym_rhs_dimlist_ (s, t);
-	  break;
-
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  ffesymbol_error (s, t);
-	  break;
-
-	case FFEEXPR_contextINCLUDE:
-	  ffesymbol_error (s, t);
-	  break;
-
-	case FFEEXPR_contextACTUALARG_:	/* E.g. I in REAL A(Y(I)). */
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  s = ffeexpr_sym_rhs_actualarg_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	  assert (ffeexpr_stack_->is_rhs);
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  s = ffeexpr_sym_rhs_let_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	default:
-	  ffesymbol_error (s, t);
-	  break;
-	}
-      return s;
-
-    default:
-      assert ("bad symbol state" == NULL);
-      return NULL;
-      break;
-    }
-}
-
-/* Have FOO in DATA (XYZ(FOO),...)/.../ or DATA (...,XYZ=FOO,BAR,BLETCH).
-   Could be found via the "statement-function" name space (in which case
-   it should become an iterator) or the local name space (in which case
-   it should be either a named constant, or a variable that will have an
-   sfunc name space sibling that should become an iterator).  */
-
-static ffesymbol
-ffeexpr_sym_impdoitem_ (ffesymbol sp, ffelexToken t)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffesymbolState ss;
-  ffesymbolState ns;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-
-  ss = ffesymbol_state (sp);
-
-  if (ffesymbol_sfdummyparent (sp) != NULL)
-    {				/* Have symbol in sfunc name space. */
-      switch (ss)
-	{
-	case FFESYMBOL_stateNONE:	/* Used as iterator already. */
-	  if (ffeexpr_level_ < ffesymbol_maxentrynum (sp))
-	    ffesymbol_error (sp, t);	/* Can't use dead iterator. */
-	  else
-	    {			/* Can use dead iterator because we're at at
-				   least an innermore (higher-numbered) level
-				   than the iterator's outermost
-				   (lowest-numbered) level. */
-	      ffesymbol_signal_change (sp);
-	      ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
-	      ffesymbol_set_maxentrynum (sp, ffeexpr_level_);
-	      ffesymbol_signal_unreported (sp);
-	    }
-	  break;
-
-	case FFESYMBOL_stateSEEN:	/* Seen already in this or other
-					   implied-DO.  Set symbol level
-					   number to outermost value, as that
-					   tells us we can see it as iterator
-					   at that level at the innermost. */
-	  if (ffeexpr_level_ < ffesymbol_maxentrynum (sp))
-	    {
-	      ffesymbol_signal_change (sp);
-	      ffesymbol_set_maxentrynum (sp, ffeexpr_level_);
-	      ffesymbol_signal_unreported (sp);
-	    }
-	  break;
-
-	case FFESYMBOL_stateUNCERTAIN:	/* Iterator. */
-	  assert (ffeexpr_level_ == ffesymbol_maxentrynum (sp));
-	  ffesymbol_error (sp, t);	/* (,,,I=I,10). */
-	  break;
-
-	case FFESYMBOL_stateUNDERSTOOD:
-	  break;		/* ANY. */
-
-	default:
-	  assert ("Foo Bar!!" == NULL);
-	  break;
-	}
-
-      return sp;
-    }
-
-  /* Got symbol in local name space, so we haven't seen it in impdo yet.
-     First, if it is brand-new and we're in executable statements, set the
-     attributes and exec-transition it to set state UNCERTAIN or UNDERSTOOD.
-     Second, if it is now a constant (PARAMETER), then just return it, it
-     can't be an implied-do iterator.  If it is understood, complain if it is
-     not a valid variable, but make the inner name space iterator anyway and
-     return that.  If it is not understood, improve understanding of the
-     symbol accordingly, complain accordingly, in either case make the inner
-     name space iterator and return that.  */
-
-  sa = ffesymbol_attrs (sp);
-
-  if (ffesymbol_state_is_specable (ss)
-      && ffest_seen_first_exec ())
-    {
-      assert (sa == FFESYMBOL_attrsetNONE);
-      ffesymbol_signal_change (sp);
-      ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
-      ffesymbol_resolve_intrin (sp);
-      if (ffeimplic_establish_symbol (sp))
-	ffesymbol_set_attr (sp, FFESYMBOL_attrSFARG);
-      else
-	ffesymbol_error (sp, t);
-
-      /* After the exec transition, the state will either be UNCERTAIN (could
-	 be a dummy or local var) or UNDERSTOOD (local var, because this is a
-	 PROGRAM/BLOCKDATA program unit).  */
-
-      sp = ffecom_sym_exec_transition (sp);
-      sa = ffesymbol_attrs (sp);
-      ss = ffesymbol_state (sp);
-    }
-
-  ns = ss;
-  kind = ffesymbol_kind (sp);
-  where = ffesymbol_where (sp);
-
-  if (ss == FFESYMBOL_stateUNDERSTOOD)
-    {
-      if (kind != FFEINFO_kindENTITY)
-	ffesymbol_error (sp, t);
-      if (where == FFEINFO_whereCONSTANT)
-	return sp;
-    }
-  else
-    {
-      /* Enhance understanding of local symbol.  This used to imply exec
-	 transition, but that doesn't seem necessary, since the local symbol
-	 doesn't actually get put into an ffebld tree here -- we just learn
-	 more about it, just like when we see a local symbol's name in the
-	 dummy-arg list of a statement function.  */
-
-      if (ss != FFESYMBOL_stateUNCERTAIN)
-	{
-	  /* Figure out what kind of object we've got based on previous
-	     declarations of or references to the object. */
-
-	  ns = FFESYMBOL_stateSEEN;
-
-	  if (sa & FFESYMBOL_attrsANY)
-	    na = sa;
-	  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
-			    | FFESYMBOL_attrsANY
-			    | FFESYMBOL_attrsCOMMON
-			    | FFESYMBOL_attrsDUMMY
-			    | FFESYMBOL_attrsEQUIV
-			    | FFESYMBOL_attrsINIT
-			    | FFESYMBOL_attrsNAMELIST
-			    | FFESYMBOL_attrsRESULT
-			    | FFESYMBOL_attrsSAVE
-			    | FFESYMBOL_attrsSFARG
-			    | FFESYMBOL_attrsTYPE)))
-	    na = sa | FFESYMBOL_attrsSFARG;
-	  else
-	    na = FFESYMBOL_attrsetNONE;
-	}
-      else
-	{			/* stateUNCERTAIN. */
-	  na = sa | FFESYMBOL_attrsSFARG;
-	  ns = FFESYMBOL_stateUNDERSTOOD;
-
-	  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-			   | FFESYMBOL_attrsADJUSTABLE
-			   | FFESYMBOL_attrsANYLEN
-			   | FFESYMBOL_attrsARRAY
-			   | FFESYMBOL_attrsDUMMY
-			   | FFESYMBOL_attrsEXTERNAL
-			   | FFESYMBOL_attrsSFARG
-			   | FFESYMBOL_attrsTYPE)));
-
-	  if (sa & FFESYMBOL_attrsEXTERNAL)
-	    {
-	      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-			       | FFESYMBOL_attrsDUMMY
-			       | FFESYMBOL_attrsEXTERNAL
-			       | FFESYMBOL_attrsTYPE)));
-
-	      na = FFESYMBOL_attrsetNONE;
-	    }
-	  else if (sa & FFESYMBOL_attrsDUMMY)
-	    {
-	      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-	      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-			       | FFESYMBOL_attrsEXTERNAL
-			       | FFESYMBOL_attrsTYPE)));
-
-	      kind = FFEINFO_kindENTITY;
-	    }
-	  else if (sa & FFESYMBOL_attrsARRAY)
-	    {
-	      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-			       | FFESYMBOL_attrsADJUSTABLE
-			       | FFESYMBOL_attrsTYPE)));
-
-	      na = FFESYMBOL_attrsetNONE;
-	    }
-	  else if (sa & FFESYMBOL_attrsSFARG)
-	    {
-	      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-			       | FFESYMBOL_attrsTYPE)));
-
-	      ns = FFESYMBOL_stateUNCERTAIN;
-	    }
-	  else if (sa & FFESYMBOL_attrsTYPE)
-	    {
-	      assert (!(sa & (FFESYMBOL_attrsARRAY
-			      | FFESYMBOL_attrsDUMMY
-			      | FFESYMBOL_attrsEXTERNAL
-			      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-	      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-			       | FFESYMBOL_attrsADJUSTABLE
-			       | FFESYMBOL_attrsANYLEN
-			       | FFESYMBOL_attrsARRAY
-			       | FFESYMBOL_attrsDUMMY
-			       | FFESYMBOL_attrsEXTERNAL
-			       | FFESYMBOL_attrsSFARG)));
-
-	      kind = FFEINFO_kindENTITY;
-
-	      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
-		na = FFESYMBOL_attrsetNONE;
-	      else if (ffest_is_entry_valid ())
-		ns = FFESYMBOL_stateUNCERTAIN;	/* Could be DUMMY or LOCAL. */
-	      else
-		where = FFEINFO_whereLOCAL;
-	    }
-	  else
-	    na = FFESYMBOL_attrsetNONE;	/* Error. */
-	}
-
-      /* Now see what we've got for a new object: NONE means a new error
-	 cropped up; ANY means an old error to be ignored; otherwise,
-	 everything's ok, update the object (symbol) and continue on. */
-
-      if (na == FFESYMBOL_attrsetNONE)
-	ffesymbol_error (sp, t);
-      else if (!(na & FFESYMBOL_attrsANY))
-	{
-	  ffesymbol_signal_change (sp);	/* May need to back up to previous
-					   version. */
-	  if (!ffeimplic_establish_symbol (sp))
-	    ffesymbol_error (sp, t);
-	  else
-	    {
-	      ffesymbol_set_info (sp,
-				  ffeinfo_new (ffesymbol_basictype (sp),
-					       ffesymbol_kindtype (sp),
-					       ffesymbol_rank (sp),
-					       kind,
-					       where,
-					       ffesymbol_size (sp)));
-	      ffesymbol_set_attrs (sp, na);
-	      ffesymbol_set_state (sp, ns);
-	      ffesymbol_resolve_intrin (sp);
-	      if (!ffesymbol_state_is_specable (ns))
-		sp = ffecom_sym_learned (sp);
-	      ffesymbol_signal_unreported (sp);	/* For debugging purposes. */
-	    }
-	}
-    }
-
-  /* Here we create the sfunc-name-space symbol representing what should
-     become an iterator in this name space at this or an outermore (lower-
-     numbered) expression level, else the implied-DO construct is in error.  */
-
-  s = ffesymbol_declare_sfdummy (t);	/* Sets maxentrynum to 0 for new obj;
-					   also sets sfa_dummy_parent to
-					   parent symbol. */
-  assert (sp == ffesymbol_sfdummyparent (s));
-
-  ffesymbol_signal_change (s);
-  ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-  ffesymbol_set_maxentrynum (s, ffeexpr_level_);
-  ffesymbol_set_info (s,
-		      ffeinfo_new (FFEINFO_basictypeINTEGER,
-				   FFEINFO_kindtypeINTEGERDEFAULT,
-				   0,
-				   FFEINFO_kindENTITY,
-				   FFEINFO_whereIMMEDIATE,
-				   FFETARGET_charactersizeNONE));
-  ffesymbol_signal_unreported (s);
-
-  if ((ffesymbol_basictype (sp) != FFEINFO_basictypeINTEGER)
-       && (ffesymbol_basictype (sp) != FFEINFO_basictypeANY))
-    ffesymbol_error (s, t);
-
-  return s;
-}
-
-/* Have FOO in CALL FOO.  Local name space, executable context only.  */
-
-static ffesymbol
-ffeexpr_sym_lhs_call_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-  bool error = FALSE;
-
-  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
-
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	error = TRUE;
-      else
-	/* Not TYPE. */
-	{
-	  kind = FFEINFO_kindSUBROUTINE;
-
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    ;			/* Not TYPE. */
-	  else if (sa & FFESYMBOL_attrsACTUALARG)
-	    ;			/* Not DUMMY or TYPE. */
-	  else			/* Not ACTUALARG, DUMMY, or TYPE. */
-	    where = FFEINFO_whereGLOBAL;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	error = TRUE;
-      else
-	kind = FFEINFO_kindSUBROUTINE;
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      error = TRUE;
-    }
-  else if (sa == FFESYMBOL_attrsetNONE)
-    {
-      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
-
-      if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
-				  &gen, &spec, &imp))
-	{
-	  ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-	  ffesymbol_set_generic (s, gen);
-	  ffesymbol_set_specific (s, spec);
-	  ffesymbol_set_implementation (s, imp);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindSUBROUTINE,
-					   FFEINFO_whereINTRINSIC,
-					   FFETARGET_charactersizeNONE));
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_resolve_intrin (s);
-	  ffesymbol_reference (s, t, FALSE);
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-
-	  return s;
-	}
-
-      kind = FFEINFO_kindSUBROUTINE;
-      where = FFEINFO_whereGLOBAL;
-    }
-  else
-    error = TRUE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (error)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,	/* SUBROUTINE. */
-				       where,	/* GLOBAL or DUMMY. */
-				       ffesymbol_size (s)));
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      ffesymbol_reference (s, t, FALSE);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in DATA FOO/.../.  Local name space and executable context
-   only.  (This will change in the future when DATA FOO may be followed
-   by COMMON FOO or even INTEGER FOO(10), etc.)  */
-
-static ffesymbol
-ffeexpr_sym_lhs_data_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  bool error = FALSE;
-
-  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
-
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsADJUSTABLE)
-	error = TRUE;
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
-	error = TRUE;
-      else
-	{
-	  kind = FFEINFO_kindENTITY;
-	  where = FFEINFO_whereLOCAL;
-	}
-    }
-  else if (sa == FFESYMBOL_attrsetNONE)
-    {
-      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
-      kind = FFEINFO_kindENTITY;
-      where = FFEINFO_whereLOCAL;
-    }
-  else
-    error = TRUE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (error)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (!ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,	/* ENTITY. */
-				       where,	/* LOCAL. */
-				       ffesymbol_size (s)));
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in EQUIVALENCE (...,FOO,...).  Does not include
-   EQUIVALENCE (...,BAR(FOO),...).  */
-
-static ffesymbol
-ffeexpr_sym_lhs_equivalence_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-
-  na = sa = ffesymbol_attrs (s);
-  kind = FFEINFO_kindENTITY;
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!(sa & ~(FFESYMBOL_attrsADJUSTS
-	       | FFESYMBOL_attrsARRAY
-	       | FFESYMBOL_attrsCOMMON
-	       | FFESYMBOL_attrsEQUIV
-	       | FFESYMBOL_attrsINIT
-	       | FFESYMBOL_attrsNAMELIST
-	       | FFESYMBOL_attrsSAVE
-	       | FFESYMBOL_attrsSFARG
-	       | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsEQUIV;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Don't know why we're bothering to set kind and where in this code, but
-     added the following to make it complete, in case it's really important.
-     Generally this is left up to symbol exec transition.  */
-
-  if (where == FFEINFO_whereNONE)
-    {
-      if (na & (FFESYMBOL_attrsADJUSTS
-		| FFESYMBOL_attrsCOMMON))
-	where = FFEINFO_whereCOMMON;
-      else if (na & FFESYMBOL_attrsSAVE)
-	where = FFEINFO_whereLOCAL;
-    }
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,	/* Always ENTITY. */
-				       where,	/* NONE, COMMON, or LOCAL. */
-				       ffesymbol_size (s)));
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_resolve_intrin (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in OPEN(...,USEROPEN=FOO,...).  Executable context only.
-
-   Note that I think this should be considered semantically similar to
-   doing CALL XYZ(FOO), in that it should be considered like an
-   ACTUALARG context.  In particular, without EXTERNAL being specified,
-   it should not be allowed.  */
-
-static ffesymbol
-ffeexpr_sym_lhs_extfunc_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  bool needs_type = FALSE;
-  bool error = FALSE;
-
-  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
-
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	where = FFEINFO_whereGLOBAL;
-      else
-	/* Not TYPE. */
-	{
-	  kind = FFEINFO_kindFUNCTION;
-	  needs_type = TRUE;
-
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    ;			/* Not TYPE. */
-	  else if (sa & FFESYMBOL_attrsACTUALARG)
-	    ;			/* Not DUMMY or TYPE. */
-	  else			/* Not ACTUALARG, DUMMY, or TYPE. */
-	    where = FFEINFO_whereGLOBAL;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      kind = FFEINFO_kindFUNCTION;
-      if (!(sa & FFESYMBOL_attrsTYPE))
-	needs_type = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYLEN))
-	error = TRUE;
-      else
-	{
-	  kind = FFEINFO_kindFUNCTION;
-	  where = FFEINFO_whereGLOBAL;
-	}
-    }
-  else if (sa == FFESYMBOL_attrsetNONE)
-    {
-      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
-      kind = FFEINFO_kindFUNCTION;
-      where = FFEINFO_whereGLOBAL;
-      needs_type = TRUE;
-    }
-  else
-    error = TRUE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (error)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (needs_type && !ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      if (!ffesymbol_explicitwhere (s))
-	{
-	  ffebad_start (FFEBAD_NEED_EXTERNAL);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_finish ();
-	  ffesymbol_set_explicitwhere (s, TRUE);
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,	/* FUNCTION. */
-				       where,	/* GLOBAL or DUMMY. */
-				       ffesymbol_size (s)));
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      ffesymbol_reference (s, t, FALSE);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in DATA (stuff,FOO=1,10)/.../.  */
-
-static ffesymbol
-ffeexpr_sym_lhs_impdoctrl_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolState ss;
-
-  /* If the symbol isn't in the sfunc name space, pretend as though we saw a
-     reference to it already within the imp-DO construct at this level, so as
-     to get a symbol that is in the sfunc name space. But this is an
-     erroneous construct, and should be caught elsewhere.  */
-
-  if (ffesymbol_sfdummyparent (s) == NULL)
-    {
-      s = ffeexpr_sym_impdoitem_ (s, t);
-      if (ffesymbol_sfdummyparent (s) == NULL)
-	{			/* PARAMETER FOO...DATA (A(I),FOO=...). */
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-    }
-
-  ss = ffesymbol_state (s);
-
-  switch (ss)
-    {
-    case FFESYMBOL_stateNONE:	/* Used as iterator already. */
-      if (ffeexpr_level_ < ffesymbol_maxentrynum (s))
-	ffesymbol_error (s, t);	/* Can't reuse dead iterator.  F90 disallows
-				   this; F77 allows it but it is a stupid
-				   feature. */
-      else
-	{			/* Can use dead iterator because we're at at
-				   least a innermore (higher-numbered) level
-				   than the iterator's outermost
-				   (lowest-numbered) level.  This should be
-				   diagnosed later, because it means an item
-				   in this list didn't reference this
-				   iterator. */
-#if 1
-	  ffesymbol_error (s, t);	/* For now, complain. */
-#else /* Someday will detect all cases where initializer doesn't reference
-	 all applicable iterators, in which case reenable this code. */
-	  ffesymbol_signal_change (s);
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN);
-	  ffesymbol_set_maxentrynum (s, ffeexpr_level_);
-	  ffesymbol_signal_unreported (s);
-#endif
-	}
-      break;
-
-    case FFESYMBOL_stateSEEN:	/* Seen already in this or other implied-DO.
-				   If seen in outermore level, can't be an
-				   iterator here, so complain.  If not seen
-				   at current level, complain for now,
-				   because that indicates something F90
-				   rejects (though we currently don't detect
-				   all such cases for now). */
-      if (ffeexpr_level_ <= ffesymbol_maxentrynum (s))
-	{
-	  ffesymbol_signal_change (s);
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNCERTAIN);
-	  ffesymbol_signal_unreported (s);
-	}
-      else
-	ffesymbol_error (s, t);
-      break;
-
-    case FFESYMBOL_stateUNCERTAIN:	/* Already iterator! */
-      assert ("DATA implied-DO control var seen twice!!" == NULL);
-      ffesymbol_error (s, t);
-      break;
-
-    case FFESYMBOL_stateUNDERSTOOD:
-      break;			/* ANY. */
-
-    default:
-      assert ("Foo Bletch!!" == NULL);
-      break;
-    }
-
-  return s;
-}
-
-/* Have FOO in PARAMETER (FOO=...).  */
-
-static ffesymbol
-ffeexpr_sym_lhs_parameter_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & ~(FFESYMBOL_attrsANYLEN
-	     | FFESYMBOL_attrsTYPE))
-    {
-      if (!(sa & FFESYMBOL_attrsANY))
-	ffesymbol_error (s, t);
-    }
-  else
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (!ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       FFEINFO_kindENTITY,
-				       FFEINFO_whereCONSTANT,
-				       ffesymbol_size (s)));
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in CALL XYZ(...,FOO,...).  Does not include any other
-   embedding of FOO, such as CALL XYZ((FOO)) or CALL XYZ(FOO+1).  */
-
-static ffesymbol
-ffeexpr_sym_rhs_actualarg_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  ffesymbolState ns;
-  bool needs_type = FALSE;
-
-  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
-
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  ns = FFESYMBOL_stateUNDERSTOOD;
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	where = FFEINFO_whereGLOBAL;
-      else
-	/* Not TYPE. */
-	{
-	  ns = FFESYMBOL_stateUNCERTAIN;
-
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    assert (kind == FFEINFO_kindNONE);	/* FUNCTION, SUBROUTINE. */
-	  else if (sa & FFESYMBOL_attrsACTUALARG)
-	    ;			/* Not DUMMY or TYPE. */
-	  else
-	    /* Not ACTUALARG, DUMMY, or TYPE. */
-	    {
-	      assert (kind == FFEINFO_kindNONE);	/* FUNCTION, SUBROUTINE. */
-	      na |= FFESYMBOL_attrsACTUALARG;
-	      where = FFEINFO_whereGLOBAL;
-	    }
-	}
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      kind = FFEINFO_kindENTITY;
-      if (!(sa & FFESYMBOL_attrsTYPE))
-	needs_type = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      if (sa & FFESYMBOL_attrsANYLEN)
-	ns = FFESYMBOL_stateNONE;
-      else
-	{
-	  kind = FFEINFO_kindENTITY;
-	  where = FFEINFO_whereLOCAL;
-	}
-    }
-  else if (sa == FFESYMBOL_attrsetNONE)
-    {
-      /* New state is left empty because there isn't any state flag to
-	 set for this case, and it's UNDERSTOOD after all.  */
-      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
-      kind = FFEINFO_kindENTITY;
-      where = FFEINFO_whereLOCAL;
-      needs_type = TRUE;
-    }
-  else
-    ns = FFESYMBOL_stateNONE;	/* Error. */
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (ns == FFESYMBOL_stateNONE)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (needs_type && !ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,
-				       where,
-				       ffesymbol_size (s)));
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, ns);
-      s = ffecom_sym_learned (s);
-      ffesymbol_reference (s, t, FALSE);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in DIMENSION XYZ(FOO) or any array declarator containing
-   a reference to FOO.  */
-
-static ffesymbol
-ffeexpr_sym_rhs_dimlist_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-
-  na = sa = ffesymbol_attrs (s);
-  kind = FFEINFO_kindENTITY;
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!(sa & ~(FFESYMBOL_attrsADJUSTS
-	       | FFESYMBOL_attrsCOMMON
-	       | FFESYMBOL_attrsDUMMY
-	       | FFESYMBOL_attrsEQUIV
-	       | FFESYMBOL_attrsINIT
-	       | FFESYMBOL_attrsNAMELIST
-	       | FFESYMBOL_attrsSFARG
-               | FFESYMBOL_attrsARRAY
-	       | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsADJUSTS;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Since this symbol definitely is going into an expression (the
-     dimension-list for some dummy array, presumably), figure out WHERE if
-     possible.  */
-
-  if (where == FFEINFO_whereNONE)
-    {
-      if (na & (FFESYMBOL_attrsCOMMON
-		| FFESYMBOL_attrsEQUIV
-		| FFESYMBOL_attrsINIT
-		| FFESYMBOL_attrsNAMELIST))
-	where = FFEINFO_whereCOMMON;
-      else if (na & FFESYMBOL_attrsDUMMY)
-	where = FFEINFO_whereDUMMY;
-    }
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (!ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,	/* Always ENTITY. */
-				       where,	/* NONE, COMMON, or DUMMY. */
-				       ffesymbol_size (s)));
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_resolve_intrin (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* Have FOO in XYZ = ...FOO....  Does not include cases like FOO in
-   XYZ = BAR(FOO), as such cases are handled elsewhere.  */
-
-static ffesymbol
-ffeexpr_sym_rhs_let_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  bool error = FALSE;
-
-  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
-
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      error = TRUE;
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      kind = FFEINFO_kindENTITY;
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      if (sa & FFESYMBOL_attrsANYLEN)
-	error = TRUE;
-      else
-	{
-	  kind = FFEINFO_kindENTITY;
-	  where = FFEINFO_whereLOCAL;
-	}
-    }
-  else if (sa == FFESYMBOL_attrsetNONE)
-    {
-      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
-      kind = FFEINFO_kindENTITY;
-      where = FFEINFO_whereLOCAL;
-    }
-  else
-    error = TRUE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (error)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (!ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,	/* ENTITY. */
-				       where,	/* LOCAL. */
-				       ffesymbol_size (s)));
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* ffeexpr_declare_parenthesized_ -- ffesymbol wrapper for NAME(...) operand
-
-   ffelexToken t;
-   bool maybe_intrin;
-   ffeexprParenType_ paren_type;
-   ffesymbol s;
-   s = ffeexpr_declare_parenthesized_ (t, maybe_intrin, &paren_type);
-
-   Just like ffesymbol_declare_local, except performs any implicit info
-   assignment necessary, and it returns the type of the parenthesized list
-   (list of function args, list of array args, or substring spec).  */
-
-static ffesymbol
-ffeexpr_declare_parenthesized_ (ffelexToken t, bool maybe_intrin,
-				ffeexprParenType_ *paren_type)
-{
-  ffesymbol s;
-  ffesymbolState st;		/* Effective state. */
-  ffeinfoKind k;
-  bool bad;
-
-  if (maybe_intrin && ffesrc_check_symbol ())
-    {				/* Knock off some easy cases. */
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextSUBROUTINEREF:
-	case FFEEXPR_contextDATA:
-	case FFEEXPR_contextDATAIMPDOINDEX_:
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextLET:
-	case FFEEXPR_contextPAREN_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextDO:
-	case FFEEXPR_contextDOWHILE:
-	case FFEEXPR_contextACTUALARG_:
-	case FFEEXPR_contextCGOTO:
-	case FFEEXPR_contextIF:
-	case FFEEXPR_contextARITHIF:
-	case FFEEXPR_contextFORMAT:
-	case FFEEXPR_contextSTOP:
-	case FFEEXPR_contextRETURN:
-	case FFEEXPR_contextSELECTCASE:
-	case FFEEXPR_contextCASE:
-	case FFEEXPR_contextFILEASSOC:
-	case FFEEXPR_contextFILEINT:
-	case FFEEXPR_contextFILEDFINT:
-	case FFEEXPR_contextFILELOG:
-	case FFEEXPR_contextFILENUM:
-	case FFEEXPR_contextFILENUMAMBIG:
-	case FFEEXPR_contextFILECHAR:
-	case FFEEXPR_contextFILENUMCHAR:
-	case FFEEXPR_contextFILEDFCHAR:
-	case FFEEXPR_contextFILEKEY:
-	case FFEEXPR_contextFILEUNIT:
-	case FFEEXPR_contextFILEUNIT_DF:
-	case FFEEXPR_contextFILEUNITAMBIG:
-	case FFEEXPR_contextFILEFORMAT:
-	case FFEEXPR_contextFILENAMELIST:
-	case FFEEXPR_contextFILEVXTCODE:
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextIMPDOITEM_:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	case FFEEXPR_contextIMPDOCTRL_:
-	case FFEEXPR_contextDATAIMPDOCTRL_:
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextPARAMETER:
-	case FFEEXPR_contextDIMLIST:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  break;		/* These could be intrinsic invocations. */
-
-	case FFEEXPR_contextAGOTO:
-	case FFEEXPR_contextFILEFORMATNML:
-	case FFEEXPR_contextALLOCATE:
-	case FFEEXPR_contextDEALLOCATE:
-	case FFEEXPR_contextHEAPSTAT:
-	case FFEEXPR_contextNULLIFY:
-	case FFEEXPR_contextINCLUDE:
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	case FFEEXPR_contextLOC_:
-	case FFEEXPR_contextINDEXORACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	case FFEEXPR_contextPARENFILENUM_:
-	case FFEEXPR_contextPARENFILEUNIT_:
-	  maybe_intrin = FALSE;
-	  break;		/* Can't be intrinsic invocation. */
-
-	default:
-	  assert ("blah! blah! waaauuggh!" == NULL);
-	  break;
-	}
-    }
-
-  s = ffesymbol_declare_local (t, maybe_intrin);
-
-  switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-    /* Special-case these since they can involve a different concept
-       of "state" (in the stmtfunc name space).  */
-    {
-    case FFEEXPR_contextDATAIMPDOINDEX_:
-    case FFEEXPR_contextDATAIMPDOCTRL_:
-      if (ffeexpr_context_outer_ (ffeexpr_stack_)
-	  == FFEEXPR_contextDATAIMPDOINDEX_)
-	s = ffeexpr_sym_impdoitem_ (s, t);
-      else
-	if (ffeexpr_stack_->is_rhs)
-	  s = ffeexpr_sym_impdoitem_ (s, t);
-	else
-	  s = ffeexpr_sym_lhs_impdoctrl_ (s, t);
-      if (ffesymbol_kind (s) != FFEINFO_kindANY)
-	ffesymbol_error (s, t);
-      return s;
-
-    default:
-      break;
-    }
-
-  switch ((ffesymbol_sfdummyparent (s) == NULL)
-	  ? ffesymbol_state (s)
-	  : FFESYMBOL_stateUNDERSTOOD)
-    {
-    case FFESYMBOL_stateNONE:	/* Before first exec, not seen in expr
-				   context. */
-      if (!ffest_seen_first_exec ())
-	goto seen;		/* :::::::::::::::::::: */
-      /* Fall through. */
-    case FFESYMBOL_stateUNCERTAIN:	/* Unseen since first exec. */
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextSUBROUTINEREF:
-	  s = ffeexpr_sym_lhs_call_ (s, t);	/* "CALL FOO"=="CALL
-						   FOO(...)". */
-	  break;
-
-	case FFEEXPR_contextDATA:
-	  if (ffeexpr_stack_->is_rhs)
-	    s = ffeexpr_sym_rhs_let_ (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_data_ (s, t);
-	  break;
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  s = ffeexpr_sym_lhs_data_ (s, t);
-	  break;
-
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  /* Fall through. */
-	case FFEEXPR_contextLET:
-	case FFEEXPR_contextPAREN_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextDO:
-	case FFEEXPR_contextDOWHILE:
-	case FFEEXPR_contextACTUALARG_:
-	case FFEEXPR_contextCGOTO:
-	case FFEEXPR_contextIF:
-	case FFEEXPR_contextARITHIF:
-	case FFEEXPR_contextFORMAT:
-	case FFEEXPR_contextSTOP:
-	case FFEEXPR_contextRETURN:
-	case FFEEXPR_contextSELECTCASE:
-	case FFEEXPR_contextCASE:
-	case FFEEXPR_contextFILEASSOC:
-	case FFEEXPR_contextFILEINT:
-	case FFEEXPR_contextFILEDFINT:
-	case FFEEXPR_contextFILELOG:
-	case FFEEXPR_contextFILENUM:
-	case FFEEXPR_contextFILENUMAMBIG:
-	case FFEEXPR_contextFILECHAR:
-	case FFEEXPR_contextFILENUMCHAR:
-	case FFEEXPR_contextFILEDFCHAR:
-	case FFEEXPR_contextFILEKEY:
-	case FFEEXPR_contextFILEUNIT:
-	case FFEEXPR_contextFILEUNIT_DF:
-	case FFEEXPR_contextFILEUNITAMBIG:
-	case FFEEXPR_contextFILEFORMAT:
-	case FFEEXPR_contextFILENAMELIST:
-	case FFEEXPR_contextFILEVXTCODE:
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextIMPDOITEM_:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	case FFEEXPR_contextIMPDOCTRL_:
-	case FFEEXPR_contextLOC_:
-	  if (ffeexpr_stack_->is_rhs)
-	    s = ffeexpr_paren_rhs_let_ (s, t);
-	  else
-	    s = ffeexpr_paren_lhs_let_ (s, t);
-	  break;
-
-	case FFEEXPR_contextASSIGN:
-	case FFEEXPR_contextAGOTO:
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextEQUIVALENCE:
-	case FFEEXPR_contextINCLUDE:
-	case FFEEXPR_contextPARAMETER:
-	case FFEEXPR_contextDIMLIST:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  break;		/* Will turn into errors below. */
-
-	default:
-	  ffesymbol_error (s, t);
-	  break;
-	}
-      /* Fall through. */
-    case FFESYMBOL_stateUNDERSTOOD:	/* Nothing much more to learn. */
-    understood:		/* :::::::::::::::::::: */
-
-      /* State might have changed, update it.  */
-      st = ((ffesymbol_sfdummyparent (s) == NULL)
-	    ? ffesymbol_state (s)
-	    : FFESYMBOL_stateUNDERSTOOD);
-
-      k = ffesymbol_kind (s);
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextSUBROUTINEREF:
-	  bad = ((k != FFEINFO_kindSUBROUTINE)
-		 && ((ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
-		     || (k != FFEINFO_kindNONE)));
-	  break;
-
-	case FFEEXPR_contextDATA:
-	  if (ffeexpr_stack_->is_rhs)
-	    bad = (k != FFEINFO_kindENTITY)
-	      || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
-	  else
-	    bad = (k != FFEINFO_kindENTITY)
-	      || ((ffesymbol_where (s) != FFEINFO_whereNONE)
-		  && (ffesymbol_where (s) != FFEINFO_whereLOCAL)
-		  && (ffesymbol_where (s) != FFEINFO_whereCOMMON));
-	  break;
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  bad = (k != FFEINFO_kindENTITY) || (ffesymbol_rank (s) == 0)
-	    || ((ffesymbol_where (s) != FFEINFO_whereNONE)
-		&& (ffesymbol_where (s) != FFEINFO_whereLOCAL)
-		&& (ffesymbol_where (s) != FFEINFO_whereCOMMON));
-	  break;
-
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextLET:
-	case FFEEXPR_contextPAREN_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextIOLIST:
-	case FFEEXPR_contextIOLISTDF:
-	case FFEEXPR_contextDO:
-	case FFEEXPR_contextDOWHILE:
-	case FFEEXPR_contextACTUALARG_:
-	case FFEEXPR_contextCGOTO:
-	case FFEEXPR_contextIF:
-	case FFEEXPR_contextARITHIF:
-	case FFEEXPR_contextFORMAT:
-	case FFEEXPR_contextSTOP:
-	case FFEEXPR_contextRETURN:
-	case FFEEXPR_contextSELECTCASE:
-	case FFEEXPR_contextCASE:
-	case FFEEXPR_contextFILEASSOC:
-	case FFEEXPR_contextFILEINT:
-	case FFEEXPR_contextFILEDFINT:
-	case FFEEXPR_contextFILELOG:
-	case FFEEXPR_contextFILENUM:
-	case FFEEXPR_contextFILENUMAMBIG:
-	case FFEEXPR_contextFILECHAR:
-	case FFEEXPR_contextFILENUMCHAR:
-	case FFEEXPR_contextFILEDFCHAR:
-	case FFEEXPR_contextFILEKEY:
-	case FFEEXPR_contextFILEUNIT:
-	case FFEEXPR_contextFILEUNIT_DF:
-	case FFEEXPR_contextFILEUNITAMBIG:
-	case FFEEXPR_contextFILEFORMAT:
-	case FFEEXPR_contextFILENAMELIST:
-	case FFEEXPR_contextFILEVXTCODE:
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextIMPDOITEM_:
-	case FFEEXPR_contextIMPDOITEMDF_:
-	case FFEEXPR_contextIMPDOCTRL_:
-	case FFEEXPR_contextLOC_:
-	  bad = FALSE;		/* Let paren-switch handle the cases. */
-	  break;
-
-	case FFEEXPR_contextASSIGN:
-	case FFEEXPR_contextAGOTO:
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextEQUIVALENCE:
-	case FFEEXPR_contextPARAMETER:
-	case FFEEXPR_contextDIMLIST:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  bad = (k != FFEINFO_kindENTITY)
-	    || (ffesymbol_where (s) != FFEINFO_whereCONSTANT);
-	  break;
-
-	case FFEEXPR_contextINCLUDE:
-	  bad = TRUE;
-	  break;
-
-	default:
-	  bad = TRUE;
-	  break;
-	}
-
-      switch (bad ? FFEINFO_kindANY : k)
-	{
-	case FFEINFO_kindNONE:	/* Case "CHARACTER X,Y; Y=X(?". */
-	  if (ffesymbol_where (s) == FFEINFO_whereINTRINSIC)
-	    {
-	      if (ffeexpr_context_outer_ (ffeexpr_stack_)
-		  == FFEEXPR_contextSUBROUTINEREF)
-		*paren_type = FFEEXPR_parentypeSUBROUTINE_;
-	      else
-		*paren_type = FFEEXPR_parentypeFUNCTION_;
-	      break;
-	    }
-	  if (st == FFESYMBOL_stateUNDERSTOOD)
-	    {
-	      bad = TRUE;
-	      *paren_type = FFEEXPR_parentypeANY_;
-	    }
-	  else
-	    *paren_type = FFEEXPR_parentypeFUNSUBSTR_;
-	  break;
-
-	case FFEINFO_kindFUNCTION:
-	  *paren_type = FFEEXPR_parentypeFUNCTION_;
-	  switch (ffesymbol_where (s))
-	    {
-	    case FFEINFO_whereLOCAL:
-	      bad = TRUE;	/* Attempt to recurse! */
-	      break;
-
-	    case FFEINFO_whereCONSTANT:
-	      bad = ((ffesymbol_sfexpr (s) == NULL)
-		     || (ffebld_op (ffesymbol_sfexpr (s))
-			 == FFEBLD_opANY));	/* Attempt to recurse! */
-	      break;
-
-	    default:
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_kindSUBROUTINE:
-	  if ((ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
-	      || (ffeexpr_stack_->previous != NULL))
-	    {
-	      bad = TRUE;
-	      *paren_type = FFEEXPR_parentypeANY_;
-	      break;
-	    }
-
-	  *paren_type = FFEEXPR_parentypeSUBROUTINE_;
-	  switch (ffesymbol_where (s))
-	    {
-	    case FFEINFO_whereLOCAL:
-	    case FFEINFO_whereCONSTANT:
-	      bad = TRUE;	/* Attempt to recurse! */
-	      break;
-
-	    default:
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_kindENTITY:
-	  if (ffesymbol_rank (s) == 0)
-	    {
-	      if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
-		*paren_type = FFEEXPR_parentypeSUBSTRING_;
-	      else
-		{
-		  bad = TRUE;
-		  *paren_type = FFEEXPR_parentypeANY_;
-		}
-	    }
-	  else
-	    *paren_type = FFEEXPR_parentypeARRAY_;
-	  break;
-
-	default:
-	case FFEINFO_kindANY:
-	  bad = TRUE;
-	  *paren_type = FFEEXPR_parentypeANY_;
-	  break;
-	}
-
-      if (bad)
-	{
-	  if (k == FFEINFO_kindANY)
-	    ffest_shutdown ();
-	  else
-	    ffesymbol_error (s, t);
-	}
-
-      return s;
-
-    case FFESYMBOL_stateSEEN:	/* Seen but not yet in exec portion. */
-    seen:			/* :::::::::::::::::::: */
-      bad = TRUE;
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextPARAMETER:
-	  if (ffeexpr_stack_->is_rhs)
-	    ffesymbol_error (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_parameter_ (s, t);
-	  break;
-
-	case FFEEXPR_contextDATA:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  if (ffeexpr_stack_->is_rhs)
-	    ffesymbol_error (s, t);
-	  else
-	    s = ffeexpr_sym_lhs_data_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  s = ffeexpr_sym_lhs_data_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	case FFEEXPR_contextEQUIVALENCE:
-	  s = ffeexpr_sym_lhs_equivalence_ (s, t);
-	  bad = FALSE;
-	  break;
-
-	case FFEEXPR_contextDIMLIST:
-	  s = ffeexpr_sym_rhs_dimlist_ (s, t);
-          bad = FALSE;
-	  break;
-
-	case FFEEXPR_contextCHARACTERSIZE:
-	case FFEEXPR_contextKINDTYPE:
-	case FFEEXPR_contextDIMLISTCOMMON:
-	case FFEEXPR_contextINITVAL:
-	case FFEEXPR_contextEQVINDEX_:
-	  break;
-
-	case FFEEXPR_contextINCLUDE:
-	  break;
-
-	case FFEEXPR_contextINDEX_:
-	case FFEEXPR_contextACTUALARGEXPR_:
-	case FFEEXPR_contextINDEXORACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	  assert (ffeexpr_stack_->is_rhs);
-	  s = ffecom_sym_exec_transition (s);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	    goto understood;	/* :::::::::::::::::::: */
-	  s = ffeexpr_paren_rhs_let_ (s, t);
-	  goto understood;	/* :::::::::::::::::::: */
-
-	default:
-	  break;
-	}
-      k = ffesymbol_kind (s);
-      switch (bad ? FFEINFO_kindANY : k)
-	{
-	case FFEINFO_kindNONE:	/* Case "CHARACTER X,Y; Y=X(?". */
-	  *paren_type = FFEEXPR_parentypeFUNSUBSTR_;
-	  break;
-
-	case FFEINFO_kindFUNCTION:
-	  *paren_type = FFEEXPR_parentypeFUNCTION_;
-	  switch (ffesymbol_where (s))
-	    {
-	    case FFEINFO_whereLOCAL:
-	      bad = TRUE;	/* Attempt to recurse! */
-	      break;
-
-	    case FFEINFO_whereCONSTANT:
-	      bad = ((ffesymbol_sfexpr (s) == NULL)
-		     || (ffebld_op (ffesymbol_sfexpr (s))
-			 == FFEBLD_opANY));	/* Attempt to recurse! */
-	      break;
-
-	    default:
-	      break;
-	    }
-	  break;
-
-	case FFEINFO_kindSUBROUTINE:
-	  *paren_type = FFEEXPR_parentypeANY_;
-	  bad = TRUE;		/* Cannot possibly be in
-				   contextSUBROUTINEREF. */
-	  break;
-
-	case FFEINFO_kindENTITY:
-	  if (ffesymbol_rank (s) == 0)
-	    {
-	      if (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE)
-		*paren_type = FFEEXPR_parentypeEQUIVALENCE_;
-	      else if (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
-		*paren_type = FFEEXPR_parentypeSUBSTRING_;
-	      else
-		{
-		  bad = TRUE;
-		  *paren_type = FFEEXPR_parentypeANY_;
-		}
-	    }
-	  else
-	    *paren_type = FFEEXPR_parentypeARRAY_;
-	  break;
-
-	default:
-	case FFEINFO_kindANY:
-	  bad = TRUE;
-	  *paren_type = FFEEXPR_parentypeANY_;
-	  break;
-	}
-
-      if (bad)
-	{
-	  if (k == FFEINFO_kindANY)
-	    ffest_shutdown ();
-	  else
-	    ffesymbol_error (s, t);
-	}
-
-      return s;
-
-    default:
-      assert ("bad symbol state" == NULL);
-      return NULL;
-    }
-}
-
-/* Have FOO in XYZ = ...FOO(...)....  Executable context only.  */
-
-static ffesymbol
-ffeexpr_paren_rhs_let_ (ffesymbol s, ffelexToken t)
-{
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-  bool maybe_ambig = FALSE;
-  bool error = FALSE;
-
-  assert ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	  || (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN));
-
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	where = FFEINFO_whereGLOBAL;
-      else
-	/* Not TYPE. */
-	{
-	  kind = FFEINFO_kindFUNCTION;
-
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    ;			/* Not TYPE. */
-	  else if (sa & FFESYMBOL_attrsACTUALARG)
-	    ;			/* Not DUMMY or TYPE. */
-	  else			/* Not ACTUALARG, DUMMY, or TYPE. */
-	    where = FFEINFO_whereGLOBAL;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      kind = FFEINFO_kindFUNCTION;
-      maybe_ambig = TRUE;	/* If basictypeCHARACTER, can't be sure; kind
-				   could be ENTITY w/substring ref. */
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      where = FFEINFO_whereLOCAL;	/* Actually an error, but at least we
-					   know it's a local var. */
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
-				  &gen, &spec, &imp))
-	{
-	  if (!(sa & FFESYMBOL_attrsANYLEN)
-	      && (ffeimplic_peek_symbol_type (s, NULL)
-		  == FFEINFO_basictypeCHARACTER))
-	    return s;		/* Haven't learned anything yet. */
-
-	  ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-	  ffesymbol_set_generic (s, gen);
-	  ffesymbol_set_specific (s, spec);
-	  ffesymbol_set_implementation (s, imp);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (ffesymbol_basictype (s),
-					   ffesymbol_kindtype (s),
-					   0,
-					   FFEINFO_kindFUNCTION,
-					   FFEINFO_whereINTRINSIC,
-					   ffesymbol_size (s)));
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_resolve_intrin (s);
-	  ffesymbol_reference (s, t, FALSE);
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-
-	  return s;
-	}
-      if (sa & FFESYMBOL_attrsANYLEN)
-	error = TRUE;		/* Error, since the only way we can,
-				   given CHARACTER*(*) FOO, accept
-				   FOO(...) is for FOO to be a dummy
-				   arg or constant, but it can't
-				   become either now. */
-      else if (sa & FFESYMBOL_attrsADJUSTABLE)
-	{
-	  kind = FFEINFO_kindENTITY;
-	  where = FFEINFO_whereLOCAL;
-	}
-      else
-	{
-	  kind = FFEINFO_kindFUNCTION;
-	  where = FFEINFO_whereGLOBAL;
-	  maybe_ambig = TRUE;	/* If basictypeCHARACTER, can't be sure;
-				   could be ENTITY/LOCAL w/substring ref. */
-	}
-    }
-  else if (sa == FFESYMBOL_attrsetNONE)
-    {
-      assert (ffesymbol_state (s) == FFESYMBOL_stateNONE);
-
-      if (ffeintrin_is_intrinsic (ffesymbol_text (s), t, FALSE,
-				  &gen, &spec, &imp))
-	{
-	  if (ffeimplic_peek_symbol_type (s, NULL)
-	      == FFEINFO_basictypeCHARACTER)
-	    return s;		/* Haven't learned anything yet. */
-
-	  ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-	  ffesymbol_set_generic (s, gen);
-	  ffesymbol_set_specific (s, spec);
-	  ffesymbol_set_implementation (s, imp);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (ffesymbol_basictype (s),
-					   ffesymbol_kindtype (s),
-					   0,
-					   FFEINFO_kindFUNCTION,
-					   FFEINFO_whereINTRINSIC,
-					   ffesymbol_size (s)));
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_resolve_intrin (s);
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_reference (s, t, FALSE);
-	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-	  return s;
-	}
-
-      kind = FFEINFO_kindFUNCTION;
-      where = FFEINFO_whereGLOBAL;
-      maybe_ambig = TRUE;	/* If basictypeCHARACTER, can't be sure;
-				   could be ENTITY/LOCAL w/substring ref. */
-    }
-  else
-    error = TRUE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (error)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);	/* May need to back up to previous
-					   version. */
-      if (!ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return s;
-	}
-      if (maybe_ambig
-	  && (ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER))
-	return s;		/* Still not sure, let caller deal with it
-				   based on (...). */
-
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,
-				       where,
-				       ffesymbol_size (s)));
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      s = ffecom_sym_learned (s);
-      ffesymbol_reference (s, t, FALSE);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* ffeexpr_token_arguments_ -- OPEN_PAREN [expr COMMA]...expr
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle expression (which might be null) and COMMA or CLOSE_PAREN.  */
-
-static ffelexHandler
-ffeexpr_token_arguments_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ procedure;
-  ffebld reduced;
-  ffeinfo info;
-  ffeexprContext ctx;
-  bool check_intrin = FALSE;	/* Set TRUE if intrinsic is REAL(Z) or AIMAG(Z). */
-
-  procedure = ffeexpr_stack_->exprstack;
-  info = ffebld_info (procedure->u.operand);
-
-  /* Is there an expression to add?  If the expression is nil,
-     it might still be an argument.  It is if:
-
-       -  The current token is comma, or
-
-       -  The -fugly-comma flag was specified *and* the procedure
-          being invoked is external.
-
-     Otherwise, if neither of the above is the case, just
-     ignore this (nil) expression.  */
-
-  if ((expr != NULL)
-      || (ffelex_token_type (t) == FFELEX_typeCOMMA)
-      || (ffe_is_ugly_comma ()
-	  && (ffeinfo_where (info) == FFEINFO_whereGLOBAL)))
-    {
-      /* This expression, even if nil, is apparently intended as an argument.  */
-
-      /* Internal procedure (CONTAINS, or statement function)?  */
-
-      if (ffeinfo_where (info) == FFEINFO_whereCONSTANT)
-	{
-	  if ((expr == NULL)
-	      && ffebad_start (FFEBAD_NULL_ARGUMENT))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-			   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	      ffebad_here (1, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_finish ();
-	    }
-
-	  if (expr == NULL)
-	    ;
-	  else
-	    {
-	      if (ffeexpr_stack_->next_dummy == NULL)
-		{			/* Report later which was the first extra argument. */
-		  if (ffeexpr_stack_->tokens[1] == NULL)
-		    {
-		      ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
-		      ffeexpr_stack_->num_args = 0;
-		    }
-		  ++ffeexpr_stack_->num_args;	/* Count # of extra arguments. */
-		}
-	      else
-		{
-		  if ((ffeinfo_rank (ffebld_info (expr)) != 0)
-		      && ffebad_start (FFEBAD_ARRAY_AS_SFARG))
-		    {
-		      ffebad_here (0,
-				   ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-				   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-		      ffebad_here (1, ffelex_token_where_line (ft),
-				   ffelex_token_where_column (ft));
-		      ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent
-						     (ffebld_symter (ffebld_head
-								     (ffeexpr_stack_->next_dummy)))));
-		      ffebad_finish ();
-		    }
-		  else
-		    {
-		      expr = ffeexpr_convert_expr (expr, ft,
-						   ffebld_head (ffeexpr_stack_->next_dummy),
-						   ffeexpr_stack_->tokens[0],
-						   FFEEXPR_contextLET);
-		      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-		    }
-		  --ffeexpr_stack_->num_args;	/* Count down # of args. */
-		  ffeexpr_stack_->next_dummy
-		    = ffebld_trail (ffeexpr_stack_->next_dummy);
-		}
-	    }
-	}
-      else
-	{
-	  if ((expr == NULL)
-	      && ffe_is_pedantic ()
-	      && ffebad_start (FFEBAD_NULL_ARGUMENT_W))
-	    {
-	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-			   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	      ffebad_here (1, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_finish ();
-	    }
-	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-	}
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFACTUALARGEXPR_:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_:
-	  ctx = FFEEXPR_contextSFUNCDEFACTUALARG_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  assert ("bad context" == NULL);
-	  ctx = FFEEXPR_context;
-	  break;
-
-	default:
-	  ctx = FFEEXPR_contextACTUALARG_;
-	  break;
-	}
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
-					  ffeexpr_token_arguments_);
-
-    default:
-      break;
-    }
-
-  if ((ffeinfo_where (info) == FFEINFO_whereCONSTANT)
-      && (ffeexpr_stack_->next_dummy != NULL))
-    {				/* Too few arguments. */
-      if (ffebad_start (FFEBAD_TOO_FEW_ARGUMENTS))
-	{
-	  char num[10];
-
-	  sprintf (num, "%" ffebldListLength_f "u", ffeexpr_stack_->num_args);
-
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	  ffebad_string (num);
-	  ffebad_string (ffesymbol_text (ffesymbol_sfdummyparent (ffebld_symter
-			      (ffebld_head (ffeexpr_stack_->next_dummy)))));
-	  ffebad_finish ();
-	}
-      for (;
-	   ffeexpr_stack_->next_dummy != NULL;
-	   ffeexpr_stack_->next_dummy
-	   = ffebld_trail (ffeexpr_stack_->next_dummy))
-	{
-	  expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
-	  ffebld_set_info (expr, ffeinfo_new_any ());
-	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-	}
-    }
-
-  if ((ffeinfo_where (info) == FFEINFO_whereCONSTANT)
-      && (ffeexpr_stack_->tokens[1] != NULL))
-    {				/* Too many arguments to statement function. */
-      if (ffebad_start (FFEBAD_TOO_MANY_ARGUMENTS))
-	{
-	  char num[10];
-
-	  sprintf (num, "%" ffebldListLength_f "u", ffeexpr_stack_->num_args);
-
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	  ffebad_string (num);
-	  ffebad_finish ();
-	}
-      ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-    }
-  ffebld_end_list (&ffeexpr_stack_->bottom);
-
-  if (ffebld_op (procedure->u.operand) == FFEBLD_opANY)
-    {
-      reduced = ffebld_new_any ();
-      ffebld_set_info (reduced, ffeinfo_new_any ());
-    }
-  else
-    {
-      if (ffeexpr_stack_->context != FFEEXPR_contextSUBROUTINEREF)
-	reduced = ffebld_new_funcref (procedure->u.operand,
-				      ffeexpr_stack_->expr);
-      else
-	reduced = ffebld_new_subrref (procedure->u.operand,
-				      ffeexpr_stack_->expr);
-      if (ffebld_symter_generic (procedure->u.operand) != FFEINTRIN_genNONE)
-	ffeintrin_fulfill_generic (&reduced, &info, ffeexpr_stack_->tokens[0]);
-      else if (ffebld_symter_specific (procedure->u.operand)
-	       != FFEINTRIN_specNONE)
-	ffeintrin_fulfill_specific (&reduced, &info, &check_intrin,
-				    ffeexpr_stack_->tokens[0]);
-      else
-	ffeexpr_fulfill_call_ (&reduced, ffeexpr_stack_->tokens[0]);
-
-      if (ffebld_op (reduced) != FFEBLD_opANY)
-	ffebld_set_info (reduced,
-			 ffeinfo_new (ffeinfo_basictype (info),
-				      ffeinfo_kindtype (info),
-				      0,
-				      FFEINFO_kindENTITY,
-				      FFEINFO_whereFLEETING,
-				      ffeinfo_size (info)));
-      else
-	ffebld_set_info (reduced, ffeinfo_new_any ());
-    }
-  if (ffebld_op (reduced) == FFEBLD_opFUNCREF)
-    reduced = ffeexpr_collapse_funcref (reduced, ffeexpr_stack_->tokens[0]);
-  ffeexpr_stack_->exprstack = procedure->previous;	/* Pops
-							   not-quite-operand off
-							   stack. */
-  procedure->u.operand = reduced;	/* Save the line/column ffewhere
-					   info. */
-  ffeexpr_exprstack_push_operand_ (procedure);	/* Push it back on stack. */
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    {
-      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-      ffeexpr_is_substr_ok_ = FALSE;	/* Nobody likes "FUNC(3)(1:1)".... */
-
-      /* If the intrinsic needs checking (is REAL(Z) or AIMAG(Z), where
-	 Z is DOUBLE COMPLEX), and a command-line option doesn't already
-	 establish interpretation, probably complain.  */
-
-      if (check_intrin
-	  && !ffe_is_90 ()
-	  && !ffe_is_ugly_complex ())
-	{
-	  /* If the outer expression is REAL(me...), issue diagnostic
-	     only if next token isn't the close-paren for REAL(me).  */
-
-	  if ((ffeexpr_stack_->previous != NULL)
-	      && (ffeexpr_stack_->previous->exprstack != NULL)
-	      && (ffeexpr_stack_->previous->exprstack->type == FFEEXPR_exprtypeOPERAND_)
-	      && ((reduced = ffeexpr_stack_->previous->exprstack->u.operand) != NULL)
-	      && (ffebld_op (reduced) == FFEBLD_opSYMTER)
-	      && (ffebld_symter_implementation (reduced) == FFEINTRIN_impREAL))
-	    return (ffelexHandler) ffeexpr_token_intrincheck_;
-
-	  /* Diagnose the ambiguity now.  */
-
-	  if (ffebad_start (FFEBAD_INTRINSIC_CMPAMBIG))
-	    {
-	      ffebad_string (ffeintrin_name_implementation
-			     (ffebld_symter_implementation
-			      (ffebld_left
-			       (ffeexpr_stack_->exprstack->u.operand))));
-	      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
-			   ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
-	      ffebad_finish ();
-	    }
-	}
-      return (ffelexHandler) ffeexpr_token_substrp_;
-    }
-
-  if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
-    {
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-      ffebad_finish ();
-    }
-  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-  ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FUNC(3)(1:1)".... */
-  return
-    (ffelexHandler) ffeexpr_find_close_paren_ (t,
-					       (ffelexHandler)
-					       ffeexpr_token_substrp_);
-}
-
-/* ffeexpr_token_elements_ -- OPEN_PAREN [expr COMMA]...expr
-
-   Return a pointer to this array to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle expression and COMMA or CLOSE_PAREN.	*/
-
-static ffelexHandler
-ffeexpr_token_elements_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ array;
-  ffebld reduced;
-  ffeinfo info;
-  ffeinfoWhere where;
-  ffetargetIntegerDefault val;
-  ffetargetIntegerDefault lval = 0;
-  ffetargetIntegerDefault uval = 0;
-  ffebld lbound;
-  ffebld ubound;
-  bool lcheck;
-  bool ucheck;
-
-  array = ffeexpr_stack_->exprstack;
-  info = ffebld_info (array->u.operand);
-
-  if ((expr == NULL)		/* && ((ffeexpr_stack_->rank != 0) ||
-				   (ffelex_token_type(t) ==
-	 FFELEX_typeCOMMA)) */ )
-    {
-      if (ffebad_start (FFEBAD_NULL_ELEMENT))
-	{
-	  ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	  ffebad_here (1, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      if (ffeexpr_stack_->rank < ffeinfo_rank (info))
-	{			/* Don't bother if we're going to complain
-				   later! */
-	  expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
-	  ffebld_set_info (expr, ffeinfo_new_any ());
-	}
-    }
-
-  if (expr == NULL)
-    ;
-  else if (ffeinfo_rank (info) == 0)
-    {				/* In EQUIVALENCE context, ffeinfo_rank(info)
-				   may == 0. */
-      ++ffeexpr_stack_->rank;	/* Track anyway, may need for new VXT
-				   feature. */
-      ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-    }
-  else
-    {
-      ++ffeexpr_stack_->rank;
-      if (ffeexpr_stack_->rank > ffeinfo_rank (info))
-	{			/* Report later which was the first extra
-				   element. */
-	  if (ffeexpr_stack_->rank == ffeinfo_rank (info) + 1)
-	    ffeexpr_stack_->tokens[1] = ffelex_token_use (ft);
-	}
-      else
-	{
-	  switch (ffeinfo_where (ffebld_info (expr)))
-	    {
-	    case FFEINFO_whereCONSTANT:
-	      break;
-
-	    case FFEINFO_whereIMMEDIATE:
-	      ffeexpr_stack_->constant = FALSE;
-	      break;
-
-	    default:
-	      ffeexpr_stack_->constant = FALSE;
-	      ffeexpr_stack_->immediate = FALSE;
-	      break;
-	    }
-	  if (ffebld_op (expr) == FFEBLD_opCONTER
-	      && ffebld_kindtype (expr) == FFEINFO_kindtypeINTEGERDEFAULT)
-	    {
-	      val = ffebld_constant_integerdefault (ffebld_conter (expr));
-
-	      lbound = ffebld_left (ffebld_head (ffeexpr_stack_->bound_list));
-	      if (lbound == NULL)
-		{
-		  lcheck = TRUE;
-		  lval = 1;
-		}
-	      else if (ffebld_op (lbound) == FFEBLD_opCONTER)
-		{
-		  lcheck = TRUE;
-		  lval = ffebld_constant_integerdefault (ffebld_conter (lbound));
-		}
-	      else
-		lcheck = FALSE;
-
-	      ubound = ffebld_right (ffebld_head (ffeexpr_stack_->bound_list));
-	      assert (ubound != NULL);
-	      if (ffebld_op (ubound) == FFEBLD_opCONTER)
-		{
-		  ucheck = TRUE;
-		  uval = ffebld_constant_integerdefault (ffebld_conter (ubound));
-		}
-	      else
-		ucheck = FALSE;
-
-	      if ((lcheck && (val < lval)) || (ucheck && (val > uval)))
-		{
-		  ffebad_start (FFEBAD_RANGE_ARRAY);
-		  ffebad_here (0, ffelex_token_where_line (ft),
-			       ffelex_token_where_column (ft));
-		  ffebad_finish ();
-		}
-	    }
-	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-	  ffeexpr_stack_->bound_list = ffebld_trail (ffeexpr_stack_->bound_list);
-	}
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      switch (ffeexpr_context_outer_ (ffeexpr_stack_))
-	{
-	case FFEEXPR_contextDATAIMPDOITEM_:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextDATAIMPDOINDEX_,
-					      ffeexpr_token_elements_);
-
-	case FFEEXPR_contextEQUIVALENCE:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextEQVINDEX_,
-					      ffeexpr_token_elements_);
-
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextSFUNCDEFINDEX_,
-					      ffeexpr_token_elements_);
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  assert ("bad context" == NULL);
-	  break;
-
-	default:
-	  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					      FFEEXPR_contextINDEX_,
-					      ffeexpr_token_elements_);
-	}
-
-    default:
-      break;
-    }
-
-  if ((ffeexpr_stack_->rank != ffeinfo_rank (info))
-      && (ffeinfo_rank (info) != 0))
-    {
-      char num[10];
-
-      if (ffeexpr_stack_->rank < ffeinfo_rank (info))
-	{
-	  if (ffebad_start (FFEBAD_TOO_FEW_ELEMENTS))
-	    {
-	      sprintf (num, "%d",
-		       (int) (ffeinfo_rank (info) - ffeexpr_stack_->rank));
-
-	      ffebad_here (0, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_here (1,
-			ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	      ffebad_string (num);
-	      ffebad_finish ();
-	    }
-	}
-      else
-	{
-	  if (ffebad_start (FFEBAD_TOO_MANY_ELEMENTS))
-	    {
-	      sprintf (num, "%d",
-		       (int) (ffeexpr_stack_->rank - ffeinfo_rank (info)));
-
-	      ffebad_here (0,
-			ffelex_token_where_line (ffeexpr_stack_->tokens[1]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[1]));
-	      ffebad_here (1,
-			ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		     ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-	      ffebad_string (num);
-	      ffebad_finish ();
-	    }
-	  ffelex_token_kill (ffeexpr_stack_->tokens[1]);
-	}
-      while (ffeexpr_stack_->rank++ < ffeinfo_rank (info))
-	{
-	  expr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
-	  ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeINTEGER,
-					      FFEINFO_kindtypeINTEGERDEFAULT,
-					      0, FFEINFO_kindENTITY,
-					      FFEINFO_whereCONSTANT,
-					      FFETARGET_charactersizeNONE));
-	  ffebld_append_item (&ffeexpr_stack_->bottom, expr);
-	}
-    }
-  ffebld_end_list (&ffeexpr_stack_->bottom);
-
-  if (ffebld_op (array->u.operand) == FFEBLD_opANY)
-    {
-      reduced = ffebld_new_any ();
-      ffebld_set_info (reduced, ffeinfo_new_any ());
-    }
-  else
-    {
-      reduced = ffebld_new_arrayref (array->u.operand, ffeexpr_stack_->expr);
-      if (ffeexpr_stack_->constant)
-	where = FFEINFO_whereFLEETING_CADDR;
-      else if (ffeexpr_stack_->immediate)
-	where = FFEINFO_whereFLEETING_IADDR;
-      else
-	where = FFEINFO_whereFLEETING;
-      ffebld_set_info (reduced,
-		       ffeinfo_new (ffeinfo_basictype (info),
-				    ffeinfo_kindtype (info),
-				    0,
-				    FFEINFO_kindENTITY,
-				    where,
-				    ffeinfo_size (info)));
-      reduced = ffeexpr_collapse_arrayref (reduced, ffeexpr_stack_->tokens[0]);
-    }
-
-  ffeexpr_stack_->exprstack = array->previous;	/* Pops not-quite-operand off
-						   stack. */
-  array->u.operand = reduced;	/* Save the line/column ffewhere info. */
-  ffeexpr_exprstack_push_operand_ (array);	/* Push it back on stack. */
-
-  switch (ffeinfo_basictype (info))
-    {
-    case FFEINFO_basictypeCHARACTER:
-      ffeexpr_is_substr_ok_ = TRUE;	/* Everyone likes "FOO(3)(1:1)".... */
-      break;
-
-    case FFEINFO_basictypeNONE:
-      ffeexpr_is_substr_ok_ = TRUE;
-      assert (ffeexpr_stack_->context == FFEEXPR_contextEQUIVALENCE);
-      break;
-
-    default:
-      ffeexpr_is_substr_ok_ = FALSE;
-      break;
-    }
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    {
-      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-      return (ffelexHandler) ffeexpr_token_substrp_;
-    }
-
-  if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
-    {
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-      ffebad_finish ();
-    }
-  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-  return
-    (ffelexHandler) ffeexpr_find_close_paren_ (t,
-					       (ffelexHandler)
-					       ffeexpr_token_substrp_);
-}
-
-/* ffeexpr_token_equivalence_ -- OPEN_PAREN expr
-
-   Return a pointer to this array to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   If token is COLON, pass off to _substr_, else init list and pass off
-   to _elements_.  This handles the case "EQUIVALENCE (FOO(expr?", where
-   ? marks the token, and where FOO's rank/type has not yet been established,
-   meaning we could be in a list of indices or in a substring
-   specification.  */
-
-static ffelexHandler
-ffeexpr_token_equivalence_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  if (ffelex_token_type (t) == FFELEX_typeCOLON)
-    return ffeexpr_token_substring_ (ft, expr, t);
-
-  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-  return ffeexpr_token_elements_ (ft, expr, t);
-}
-
-/* ffeexpr_token_substring_ -- NAME(of kindENTITY) OPEN_PAREN expr
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle expression (which may be null) and COLON.  */
-
-static ffelexHandler
-ffeexpr_token_substring_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeexprExpr_ string;
-  ffeinfo info;
-  ffetargetIntegerDefault i;
-  ffeexprContext ctx;
-  ffetargetCharacterSize size;
-
-  string = ffeexpr_stack_->exprstack;
-  info = ffebld_info (string->u.operand);
-  size = ffebld_size_max (string->u.operand);
-
-  if (ffelex_token_type (t) == FFELEX_typeCOLON)
-    {
-      if ((expr != NULL)
-	  && (ffebld_op (expr) == FFEBLD_opCONTER)
-	  && (((i = ffebld_constant_integerdefault (ffebld_conter (expr)))
-	       < 1)
-	      || ((size != FFETARGET_charactersizeNONE) && (i > size))))
-	{
-	  ffebad_start (FFEBAD_RANGE_SUBSTR);
-	  ffebad_here (0, ffelex_token_where_line (ft),
-		       ffelex_token_where_column (ft));
-	  ffebad_finish ();
-	}
-      ffeexpr_stack_->expr = expr;
-
-      switch (ffeexpr_stack_->context)
-	{
-	case FFEEXPR_contextSFUNCDEF:
-	case FFEEXPR_contextSFUNCDEFINDEX_:
-	  ctx = FFEEXPR_contextSFUNCDEFINDEX_;
-	  break;
-
-	case FFEEXPR_contextSFUNCDEFACTUALARG_:
-	case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-	  assert ("bad context" == NULL);
-	  ctx = FFEEXPR_context;
-	  break;
-
-	default:
-	  ctx = FFEEXPR_contextINDEX_;
-	  break;
-	}
-
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
-					  ffeexpr_token_substring_1_);
-    }
-
-  if (ffest_ffebad_start (FFEBAD_MISSING_COLON_IN_SUBSTR))
-    {
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-      ffebad_finish ();
-    }
-
-  ffeexpr_stack_->expr = NULL;
-  return (ffelexHandler) ffeexpr_token_substring_1_ (ft, expr, t);
-}
-
-/* ffeexpr_token_substring_1_ -- NAME OPEN_PAREN [expr COMMA]...expr
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   Handle expression (which might be null) and CLOSE_PAREN.  */
-
-static ffelexHandler
-ffeexpr_token_substring_1_ (ffelexToken ft, ffebld last, ffelexToken t)
-{
-  ffeexprExpr_ string;
-  ffebld reduced;
-  ffebld substrlist;
-  ffebld first = ffeexpr_stack_->expr;
-  ffebld strop;
-  ffeinfo info;
-  ffeinfoWhere lwh;
-  ffeinfoWhere rwh;
-  ffeinfoWhere where;
-  ffeinfoKindtype first_kt;
-  ffeinfoKindtype last_kt;
-  ffetargetIntegerDefault first_val;
-  ffetargetIntegerDefault last_val;
-  ffetargetCharacterSize size;
-  ffetargetCharacterSize strop_size_max;
-  bool first_known;
-
-  string = ffeexpr_stack_->exprstack;
-  strop = string->u.operand;
-  info = ffebld_info (strop);
-
-  if (first == NULL
-      || (ffebld_op (first) == FFEBLD_opCONTER
-	  && ffebld_kindtype (first) == FFEINFO_kindtypeINTEGERDEFAULT))
-    {				/* The starting point is known. */
-      first_val = (first == NULL) ? 1
-	: ffebld_constant_integerdefault (ffebld_conter (first));
-      first_known = TRUE;
-    }
-  else
-    {				/* Assume start of the entity. */
-      first_val = 1;
-      first_known = FALSE;
-    }
-
-  if (last != NULL
-      && (ffebld_op (last) == FFEBLD_opCONTER
-	  && ffebld_kindtype (last) == FFEINFO_kindtypeINTEGERDEFAULT))
-    {				/* The ending point is known. */
-      last_val = ffebld_constant_integerdefault (ffebld_conter (last));
-
-      if (first_known)
-	{			/* The beginning point is a constant. */
-	  if (first_val <= last_val)
-	    size = last_val - first_val + 1;
-	  else
-	    {
-	      if (0 && ffe_is_90 ())
-		size = 0;
-	      else
-		{
-		  size = 1;
-		  ffebad_start (FFEBAD_ZERO_SIZE);
-		  ffebad_here (0, ffelex_token_where_line (ft),
-			       ffelex_token_where_column (ft));
-		  ffebad_finish ();
-		}
-	    }
-	}
-      else
-	size = FFETARGET_charactersizeNONE;
-
-      strop_size_max = ffebld_size_max (strop);
-
-      if ((strop_size_max != FFETARGET_charactersizeNONE)
-	  && (last_val > strop_size_max))
-	{			/* Beyond maximum possible end of string. */
-	  ffebad_start (FFEBAD_RANGE_SUBSTR);
-	  ffebad_here (0, ffelex_token_where_line (ft),
-		       ffelex_token_where_column (ft));
-	  ffebad_finish ();
-	}
-    }
-  else
-    size = FFETARGET_charactersizeNONE;	/* The size is not known. */
-
-#if 0				/* Don't do this, or "is size of target
-				   known?" would no longer be easily
-				   answerable.	To see if there is a max
-				   size, use ffebld_size_max; to get only the
-				   known size, else NONE, use
-				   ffebld_size_known; use ffebld_size if
-				   values are sure to be the same (not
-				   opSUBSTR or opCONCATENATE or known to have
-				   known length). By getting rid of this
-				   "useful info" stuff, we don't end up
-				   blank-padding the constant in the
-				   assignment "A(I:J)='XYZ'" to the known
-				   length of A. */
-  if (size == FFETARGET_charactersizeNONE)
-    size = strop_size_max;	/* Assume we use the entire string. */
-#endif
-
-  substrlist
-    = ffebld_new_item
-    (first,
-     ffebld_new_item
-     (last,
-      NULL
-     )
-    )
-    ;
-
-  if (first == NULL)
-    lwh = FFEINFO_whereCONSTANT;
-  else
-    lwh = ffeinfo_where (ffebld_info (first));
-  if (last == NULL)
-    rwh = FFEINFO_whereCONSTANT;
-  else
-    rwh = ffeinfo_where (ffebld_info (last));
-
-  switch (lwh)
-    {
-    case FFEINFO_whereCONSTANT:
-      switch (rwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	  where = FFEINFO_whereCONSTANT;
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:
-	  where = FFEINFO_whereIMMEDIATE;
-	  break;
-
-	default:
-	  where = FFEINFO_whereFLEETING;
-	  break;
-	}
-      break;
-
-    case FFEINFO_whereIMMEDIATE:
-      switch (rwh)
-	{
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereIMMEDIATE:
-	  where = FFEINFO_whereIMMEDIATE;
-	  break;
-
-	default:
-	  where = FFEINFO_whereFLEETING;
-	  break;
-	}
-      break;
-
-    default:
-      where = FFEINFO_whereFLEETING;
-      break;
-    }
-
-  if (first == NULL)
-    first_kt = FFEINFO_kindtypeINTEGERDEFAULT;
-  else
-    first_kt = ffeinfo_kindtype (ffebld_info (first));
-  if (last == NULL)
-    last_kt = FFEINFO_kindtypeINTEGERDEFAULT;
-  else
-    last_kt = ffeinfo_kindtype (ffebld_info (last));
-
-  switch (where)
-    {
-    case FFEINFO_whereCONSTANT:
-      switch (ffeinfo_where (info))
-	{
-	case FFEINFO_whereCONSTANT:
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:	/* Not possible, actually. */
-	  where = FFEINFO_whereIMMEDIATE;
-	  break;
-
-	default:
-	  where = FFEINFO_whereFLEETING_CADDR;
-	  break;
-	}
-      break;
-
-    case FFEINFO_whereIMMEDIATE:
-      switch (ffeinfo_where (info))
-	{
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereIMMEDIATE:	/* Not possible, actually. */
-	  break;
-
-	default:
-	  where = FFEINFO_whereFLEETING_IADDR;
-	  break;
-	}
-      break;
-
-    default:
-      switch (ffeinfo_where (info))
-	{
-	case FFEINFO_whereCONSTANT:
-	  where = FFEINFO_whereCONSTANT_SUBOBJECT;	/* An F90 concept. */
-	  break;
-
-	case FFEINFO_whereIMMEDIATE:	/* Not possible, actually. */
-	default:
-	  where = FFEINFO_whereFLEETING;
-	  break;
-	}
-      break;
-    }
-
-  if (ffebld_op (strop) == FFEBLD_opANY)
-    {
-      reduced = ffebld_new_any ();
-      ffebld_set_info (reduced, ffeinfo_new_any ());
-    }
-  else
-    {
-      reduced = ffebld_new_substr (strop, substrlist);
-      ffebld_set_info (reduced, ffeinfo_new
-		       (FFEINFO_basictypeCHARACTER,
-			ffeinfo_kindtype (info),
-			0,
-			FFEINFO_kindENTITY,
-			where,
-			size));
-      reduced = ffeexpr_collapse_substr (reduced, ffeexpr_stack_->tokens[0]);
-    }
-
-  ffeexpr_stack_->exprstack = string->previous;	/* Pops not-quite-operand off
-						   stack. */
-  string->u.operand = reduced;	/* Save the line/column ffewhere info. */
-  ffeexpr_exprstack_push_operand_ (string);	/* Push it back on stack. */
-
-  if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-    {
-      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-      ffeexpr_is_substr_ok_ = FALSE;	/* Nobody likes "FOO(3:5)(1:1)".... */
-      return (ffelexHandler) ffeexpr_token_substrp_;
-    }
-
-  if (ffest_ffebad_start (FFEBAD_INVALID_TOKEN_IN_EXPRESSION))
-    {
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->tokens[0]),
-		   ffelex_token_where_column (ffeexpr_stack_->tokens[0]));
-      ffebad_finish ();
-    }
-
-  ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-  ffeexpr_is_substr_ok_ = FALSE;/* Nobody likes "FOO(3:5)(1:1)".... */
-  return
-    (ffelexHandler) ffeexpr_find_close_paren_ (t,
-					       (ffelexHandler)
-					       ffeexpr_token_substrp_);
-}
-
-/* ffeexpr_token_substrp_ -- Rhs <character entity>
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   If OPEN_PAREN, treat as start of a substring ("(3:4)") construct, and
-   issue error message if flag (serves as argument) is set.  Else, just
-   forward token to binary_.  */
-
-static ffelexHandler
-ffeexpr_token_substrp_ (ffelexToken t)
-{
-  ffeexprContext ctx;
-
-  if (ffelex_token_type (t) != FFELEX_typeOPEN_PAREN)
-    return (ffelexHandler) ffeexpr_token_binary_ (t);
-
-  ffeexpr_stack_->tokens[0] = ffelex_token_use (t);
-
-  switch (ffeexpr_stack_->context)
-    {
-    case FFEEXPR_contextSFUNCDEF:
-    case FFEEXPR_contextSFUNCDEFINDEX_:
-      ctx = FFEEXPR_contextSFUNCDEFINDEX_;
-      break;
-
-    case FFEEXPR_contextSFUNCDEFACTUALARG_:
-    case FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_:
-      assert ("bad context" == NULL);
-      ctx = FFEEXPR_context;
-      break;
-
-    default:
-      ctx = FFEEXPR_contextINDEX_;
-      break;
-    }
-
-  if (!ffeexpr_is_substr_ok_)
-    {
-      if (ffebad_start (FFEBAD_BAD_SUBSTR))
-	{
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
-		       ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
-	  ffebad_finish ();
-	}
-
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
-					  ffeexpr_token_anything_);
-    }
-
-  return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool, ctx,
-				      ffeexpr_token_substring_);
-}
-
-static ffelexHandler
-ffeexpr_token_intrincheck_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) != FFELEX_typeCLOSE_PAREN)
-      && ffebad_start (FFEBAD_INTRINSIC_CMPAMBIG))
-    {
-      ffebad_string (ffeintrin_name_implementation
-		     (ffebld_symter_implementation
-		      (ffebld_left
-		       (ffeexpr_stack_->exprstack->u.operand))));
-      ffebad_here (0, ffelex_token_where_line (ffeexpr_stack_->exprstack->token),
-		   ffelex_token_where_column (ffeexpr_stack_->exprstack->token));
-      ffebad_finish ();
-    }
-
-  return (ffelexHandler) ffeexpr_token_substrp_ (t);
-}
-
-/* ffeexpr_token_funsubstr_ -- NAME OPEN_PAREN expr
-
-   Return a pointer to this function to the lexer (ffelex), which will
-   invoke it for the next token.
-
-   If COLON, do everything we would have done since _parenthesized_ if
-   we had known NAME represented a kindENTITY instead of a kindFUNCTION.
-   If not COLON, do likewise for kindFUNCTION instead.	*/
-
-static ffelexHandler
-ffeexpr_token_funsubstr_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffeinfoWhere where;
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffebld symter = ffeexpr_stack_->exprstack->u.operand;
-  bool needs_type;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-
-  s = ffebld_symter (symter);
-  sa = ffesymbol_attrs (s);
-  where = ffesymbol_where (s);
-
-  /* We get here only if we don't already know enough about FOO when seeing a
-     FOO(stuff) reference, and FOO might turn out to be a CHARACTER type.  If
-     "stuff" is a substring reference, then FOO is a CHARACTER scalar type.
-     Else FOO is a function, either intrinsic or external.  If intrinsic, it
-     wouldn't necessarily be CHARACTER type, so unless it has already been
-     declared DUMMY, it hasn't had its type established yet.  It can't be
-     CHAR*(*) in any case, though it can have an explicit CHAR*n type.  */
-
-  assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsTYPE)));
-
-  needs_type = !(ffesymbol_attrs (s) & FFESYMBOL_attrsDUMMY);
-
-  ffesymbol_signal_change (s);	/* Probably already done, but in case.... */
-
-  if (ffelex_token_type (t) == FFELEX_typeCOLON)
-    {				/* Definitely an ENTITY (char substring). */
-      if (needs_type && !ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, ffeexpr_stack_->tokens[0]);
-	  return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
-	}
-
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       FFEINFO_kindENTITY,
-				       (where == FFEINFO_whereNONE)
-				       ? FFEINFO_whereLOCAL
-				       : where,
-				       ffesymbol_size (s)));
-      ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s)));
-
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_resolve_intrin (s);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-
-      ffeexpr_stack_->exprstack->u.operand
-	= ffeexpr_collapse_symter (symter, ffeexpr_tokens_[0]);
-
-      return (ffelexHandler) ffeexpr_token_substring_ (ft, expr, t);
-    }
-
-  /* The "stuff" isn't a substring notation, so we now know the overall
-     reference is to a function.  */
-
-  if (ffeintrin_is_intrinsic (ffesymbol_text (s), ffeexpr_stack_->tokens[0],
-			      FALSE, &gen, &spec, &imp))
-    {
-      ffebld_symter_set_generic (symter, gen);
-      ffebld_symter_set_specific (symter, spec);
-      ffebld_symter_set_implementation (symter, imp);
-      ffesymbol_set_generic (s, gen);
-      ffesymbol_set_specific (s, spec);
-      ffesymbol_set_implementation (s, imp);
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       0,
-				       FFEINFO_kindFUNCTION,
-				       FFEINFO_whereINTRINSIC,
-				       ffesymbol_size (s)));
-    }
-  else
-    {				/* Not intrinsic, now needs CHAR type. */
-      if (!ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, ffeexpr_stack_->tokens[0]);
-	  return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
-	}
-
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       FFEINFO_kindFUNCTION,
-				       (where == FFEINFO_whereNONE)
-				       ? FFEINFO_whereGLOBAL
-				       : where,
-				       ffesymbol_size (s)));
-    }
-
-  ffebld_set_info (symter, ffeinfo_use (ffesymbol_info (s)));
-
-  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-  ffesymbol_resolve_intrin (s);
-  s = ffecom_sym_learned (s);
-  ffesymbol_reference (s, ffeexpr_stack_->tokens[0], FALSE);
-  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-  ffebld_init_list (&ffeexpr_stack_->expr, &ffeexpr_stack_->bottom);
-  return (ffelexHandler) ffeexpr_token_arguments_ (ft, expr, t);
-}
-
-/* ffeexpr_token_anything_ -- NAME OPEN_PAREN any-expr
-
-   Handle basically any expression, looking for CLOSE_PAREN.  */
-
-static ffelexHandler
-ffeexpr_token_anything_ (ffelexToken ft UNUSED, ffebld expr UNUSED,
-			 ffelexToken t)
-{
-  ffeexprExpr_ e = ffeexpr_stack_->exprstack;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLON:
-      return (ffelexHandler) ffeexpr_rhs (ffeexpr_stack_->pool,
-					  FFEEXPR_contextACTUALARG_,
-					  ffeexpr_token_anything_);
-
-    default:
-      e->u.operand = ffebld_new_any ();
-      ffebld_set_info (e->u.operand, ffeinfo_new_any ());
-      ffelex_token_kill (ffeexpr_stack_->tokens[0]);
-      ffeexpr_is_substr_ok_ = FALSE;
-      if (ffelex_token_type (t) == FFELEX_typeCLOSE_PAREN)
-	return (ffelexHandler) ffeexpr_token_substrp_;
-      return (ffelexHandler) ffeexpr_token_substrp_ (t);
-    }
-}
-
-/* Terminate module.  */
-
-void
-ffeexpr_terminate_2 (void)
-{
-  assert (ffeexpr_stack_ == NULL);
-  assert (ffeexpr_level_ == 0);
-}
diff --git a/gcc/f/expr.h b/gcc/f/expr.h
deleted file mode 100644
index b82173b..0000000
--- a/gcc/f/expr.h
+++ /dev/null
@@ -1,194 +0,0 @@
-/* expr.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      expr.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_EXPR_H
-#define GCC_F_EXPR_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFEEXPR_contextLET,
-    FFEEXPR_contextASSIGN,
-    FFEEXPR_contextIOLIST,
-    FFEEXPR_contextPARAMETER,
-    FFEEXPR_contextSUBROUTINEREF,
-    FFEEXPR_contextDATA,
-    FFEEXPR_contextIF,
-    FFEEXPR_contextARITHIF,
-    FFEEXPR_contextDO,
-    FFEEXPR_contextDOWHILE,
-    FFEEXPR_contextFORMAT,
-    FFEEXPR_contextAGOTO,
-    FFEEXPR_contextCGOTO,
-    FFEEXPR_contextCHARACTERSIZE,
-    FFEEXPR_contextEQUIVALENCE,
-    FFEEXPR_contextSTOP,
-    FFEEXPR_contextRETURN,
-    FFEEXPR_contextSFUNCDEF,
-    FFEEXPR_contextINCLUDE,
-    FFEEXPR_contextWHERE,
-    FFEEXPR_contextSELECTCASE,
-    FFEEXPR_contextCASE,
-    FFEEXPR_contextDIMLIST,
-    FFEEXPR_contextDIMLISTCOMMON,	/* Dim list in COMMON stmt. */
-    FFEEXPR_contextFILEASSOC,	/* ASSOCIATEVARIABLE=. */
-    FFEEXPR_contextFILEINT,	/* IOSTAT=. */
-    FFEEXPR_contextFILEDFINT,	/* NEXTREC=. */
-    FFEEXPR_contextFILELOG,	/* NAMED=. */
-    FFEEXPR_contextFILENUM,	/* Numerical expression. */
-    FFEEXPR_contextFILECHAR,	/* Character expression. */
-    FFEEXPR_contextFILENUMCHAR,	/* READ KEYxyz=. */
-    FFEEXPR_contextFILEDFCHAR,	/* Default kind character expression. */
-    FFEEXPR_contextFILEKEY,	/* OPEN KEY=. */
-    FFEEXPR_contextFILEEXTFUNC,	/* USEROPEN=. */
-    FFEEXPR_contextFILEUNIT,	/* READ/WRITE UNIT=. */
-    FFEEXPR_contextFILEUNIT_DF,	/* DEFINE FILE unit (no "(" after it). */
-    FFEEXPR_contextFILEFORMATNML,	/* [FMT=] or [NML=]. */
-    FFEEXPR_contextFILEFORMAT,	/* FMT=. */
-    FFEEXPR_contextFILENAMELIST,/* NML=. */
-    FFEEXPR_contextFILENUMAMBIG,/* BACKSPACE, ENDFILE, REWIND, UNLOCK...
-				   where at e.g. BACKSPACE(, if COMMA seen
-				   before ), it is ok. */
-    FFEEXPR_contextFILEUNITAMBIG,	/* READ(, if COMMA seen before ), ok. */
-    FFEEXPR_contextFILEVXTCODE,	/* ENCODE/DECODE third arg (scalar/array). */
-    FFEEXPR_contextALLOCATE,	/* ALLOCATE objects (weird). */
-    FFEEXPR_contextDEALLOCATE,	/* DEALLOCATE objects (weird). */
-    FFEEXPR_contextHEAPSTAT,	/* ALLOCATE/DEALLOCATE STAT= variable. */
-    FFEEXPR_contextKINDTYPE,	/* KIND=. */
-    FFEEXPR_contextINITVAL,	/* R426 =initialization-expr. */
-    FFEEXPR_contextNULLIFY,	/* Pointer names only (F90) or pointers. */
-    FFEEXPR_contextIOLISTDF,	/* IOLIST w/internal file (V112 9-14 30,31). */
-    FFEEXPR_contextINDEX_,	/* Element dimension or substring value. */
-    FFEEXPR_contextEQVINDEX_,	/* EQUIVALENCE element dimension. */
-    FFEEXPR_contextDATAIMPDOINDEX_,	/* INDEX in DATAIMPDO context. */
-    FFEEXPR_contextIMPDOITEM_,
-    FFEEXPR_contextIMPDOITEMDF_,/* to ...ITEM_ as IOLISTDF is to IOLIST. */
-    FFEEXPR_contextIMPDOCTRL_,
-    FFEEXPR_contextDATAIMPDOITEM_,
-    FFEEXPR_contextDATAIMPDOCTRL_,
-    FFEEXPR_contextLOC_,
-    FFEEXPR_contextACTUALARG_,	/* Actual arg to function or subroutine;
-				   turns into ACTUALARGEXPR_ if tokens not
-				   NAME (CLOSE_PAREN/COMMA) or PERCENT.... */
-    FFEEXPR_contextACTUALARGEXPR_,	/* Like LET but disallow CHAR*(*)
-					   concats. */
-    FFEEXPR_contextINDEXORACTUALARG_,	/* "CHARACTER FOO; PRINT *,FOO(?". */
-    FFEEXPR_contextINDEXORACTUALARGEXPR_,	/* ? not NAME
-						   (CLOSE_PAREN/COMMA). */
-    FFEEXPR_contextSFUNCDEFINDEX_,	/* INDEX_ within stmt-func def. */
-    FFEEXPR_contextSFUNCDEFACTUALARG_,
-    FFEEXPR_contextSFUNCDEFACTUALARGEXPR_,
-    FFEEXPR_contextSFUNCDEFINDEXORACTUALARG_,
-    FFEEXPR_contextSFUNCDEFINDEXORACTUALARGEXPR_,
-    FFEEXPR_contextPAREN_,	/* Rhs paren except in LET context. */
-    FFEEXPR_contextPARENFILENUM_,	/* Either PAREN or FILENUM context. */
-    FFEEXPR_contextPARENFILEUNIT_,	/* Either PAREN or FILEUNIT context. */
-    FFEEXPR_context
-  } ffeexprContext;
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "lex.h"
-#include "malloc.h"
-
-/* Structure definitions. */
-
-typedef ffelexHandler (*ffeexprCallback) (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-ffebld ffeexpr_collapse_convert (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_paren (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_uplus (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_uminus (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_not (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_add (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_subtract (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_multiply (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_divide (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_power (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_concatenate (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_lt (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_le (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_eq (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_ne (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_gt (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_ge (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_and (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_or (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_xor (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_eqv (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_neqv (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_symter (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_funcref (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_arrayref (ffebld expr, ffelexToken t);
-ffebld ffeexpr_collapse_substr (ffebld expr, ffelexToken t);
-ffebld ffeexpr_convert (ffebld source, ffelexToken source_token,
-	    ffelexToken dest_token, ffeinfoBasictype bt, ffeinfoKindtype kt,
-			ffeinfoRank rk, ffetargetCharacterSize sz,
-			ffeexprContext context);
-ffebld ffeexpr_convert_expr (ffebld source, ffelexToken source_token,
-			     ffebld dest, ffelexToken dest_token,
-			     ffeexprContext context);
-ffebld ffeexpr_convert_to_sym (ffebld source, ffelexToken source_token,
-			       ffesymbol dest, ffelexToken dest_token);
-void ffeexpr_init_2 (void);
-ffelexHandler ffeexpr_rhs (mallocPool pool, ffeexprContext context,
-			   ffeexprCallback callback);
-ffelexHandler ffeexpr_lhs (mallocPool pool, ffeexprContext context,
-			   ffeexprCallback callback);
-void ffeexpr_terminate_2 (void);
-void ffeexpr_type_combine (ffeinfoBasictype *nbt, ffeinfoKindtype *nkt,
-			   ffeinfoBasictype lbt, ffeinfoKindtype lkt,
-			   ffeinfoBasictype rbt, ffeinfoKindtype rkt,
-			   ffelexToken t);
-
-/* Define macros. */
-
-#define ffeexpr_init_0()
-#define ffeexpr_init_1()
-#define ffeexpr_init_3()
-#define ffeexpr_init_4()
-#define ffeexpr_terminate_0()
-#define ffeexpr_terminate_1()
-#define ffeexpr_terminate_3()
-#define ffeexpr_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_EXPR_H */
diff --git a/gcc/f/ffe.texi b/gcc/f/ffe.texi
deleted file mode 100644
index fd5d3bf..0000000
--- a/gcc/f/ffe.texi
+++ /dev/null
@@ -1,2063 +0,0 @@
-@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.
-
-@node Front End
-@chapter Front End
-@cindex GNU Fortran Front End (FFE)
-@cindex FFE
-@cindex @code{g77}, front end
-@cindex front end, @code{g77}
-
-This chapter describes some aspects of the design and implementation
-of the @code{g77} front end.
-
-To find about things that are ``To Be Determined'' or ``To Be Done'',
-search for the string TBD.
-If you want to help by working on one or more of these items,
-email @email{gcc@@gcc.gnu.org}.
-If you're planning to do more than just research issues and offer comments,
-see @uref{http://gcc.gnu.org/contribute.html} for steps you might
-need to take first.
-
-@menu
-* Overview of Sources::
-* Overview of Translation Process::
-* Philosophy of Code Generation::
-* Two-pass Design::
-* Challenges Posed::
-* Transforming Statements::
-* Transforming Expressions::
-* Internal Naming Conventions::
-@end menu
-
-@node Overview of Sources
-@section Overview of Sources
-
-The current directory layout includes the following:
-
-@table @file
-@item @var{srcdir}/gcc/
-Non-g77 files in gcc
-
-@item @var{srcdir}/gcc/f/
-GNU Fortran front end sources
-
-@item @var{srcdir}/libf2c/
-@code{libg2c} configuration and @code{g2c.h} file generation
-
-@item @var{srcdir}/libf2c/libF77/
-General support and math portion of @code{libg2c}
-
-@item @var{srcdir}/libf2c/libI77/
-I/O portion of @code{libg2c}
-
-@item @var{srcdir}/libf2c/libU77/
-Additional interfaces to Unix @code{libc} for @code{libg2c}
-@end table
-
-Components of note in @code{g77} are described below.
-
-@file{f/} as a whole contains the source for @code{g77},
-while @file{libf2c/} contains a portion of the separate program
-@code{f2c}.
-Note that the @code{libf2c} code is not part of the program @code{g77},
-just distributed with it.
-
-@file{f/} contains text files that document the Fortran compiler, source
-files for the GNU Fortran Front End (FFE), and some other stuff.
-The @code{g77} compiler code is placed in @file{f/} because it,
-along with its contents,
-is designed to be a subdirectory of a @code{gcc} source directory,
-@file{gcc/},
-which is structured so that language-specific front ends can be ``dropped
-in'' as subdirectories.
-The C++ front end (@code{g++}), is an example of this---it resides in
-the @file{cp/} subdirectory.
-Note that the C front end (also referred to as @code{gcc})
-is an exception to this, as its source files reside
-in the @file{gcc/} directory itself.
-
-@file{libf2c/} contains the run-time libraries for the @code{f2c} program,
-also used by @code{g77}.
-These libraries normally referred to collectively as @code{libf2c}.
-When built as part of @code{g77},
-@code{libf2c} is installed under the name @code{libg2c} to avoid
-conflict with any existing version of @code{libf2c},
-and thus is often referred to as @code{libg2c} when the
-@code{g77} version is specifically being referred to.
-
-The @code{netlib} version of @code{libf2c/}
-contains two distinct libraries,
-@code{libF77} and @code{libI77},
-each in their own subdirectories.
-In @code{g77}, this distinction is not made,
-beyond maintaining the subdirectory structure in the source-code tree.
-
-@file{libf2c/} is not part of the program @code{g77},
-just distributed with it.
-It contains files not present
-in the official (@code{netlib}) version of @code{libf2c},
-and also contains some minor changes made from @code{libf2c},
-to fix some bugs,
-and to facilitate automatic configuration, building, and installation of
-@code{libf2c} (as @code{libg2c}) for use by @code{g77} users.
-See @file{libf2c/README} for more information,
-including licensing conditions
-governing distribution of programs containing code from @code{libg2c}.
-
-@code{libg2c}, @code{g77}'s version of @code{libf2c},
-adds Dave Love's implementation of @code{libU77},
-in the @file{libf2c/libU77/} directory.
-This library is distributed under the
-GNU Library General Public License (LGPL)---see the
-file @file{libf2c/libU77/COPYING.LIB}
-for more information,
-as this license
-governs distribution conditions for programs containing code
-from this portion of the library.
-
-Files of note in @file{f/} and @file{libf2c/} are described below:
-
-@table @file
-@item f/BUGS
-Lists some important bugs known to be in g77.
-Or use Info (or GNU Emacs Info mode) to read
-the ``Actual Bugs'' node of the @code{g77} documentation:
-
-@smallexample
-info -f f/g77.info -n "Actual Bugs"
-@end smallexample
-
-@item f/ChangeLog
-Lists recent changes to @code{g77} internals.
-
-@item libf2c/ChangeLog
-Lists recent changes to @code{libg2c} internals.
-
-@item f/NEWS
-Contains the per-release changes.
-These include the user-visible
-changes described in the node ``Changes''
-in the @code{g77} documentation, plus internal
-changes of import.
-Or use:
-
-@smallexample
-info -f f/g77.info -n News
-@end smallexample
-
-@item f/g77.info*
-The @code{g77} documentation, in Info format,
-produced by building @code{g77}.
-
-All users of @code{g77} (not just installers) should read this,
-using the @code{more} command if neither the @code{info} command,
-nor GNU Emacs (with its Info mode), are available, or if users
-aren't yet accustomed to using these tools.
-All of these files are readable as ``plain text'' files,
-though they're easier to navigate using Info readers
-such as @code{info} and GNU Emacs Info mode.
-@end table
-
-If you want to explore the FFE code, which lives entirely in @file{f/},
-here are a few clues.
-The file @file{g77spec.c} contains the @code{g77}-specific source code
-for the @code{g77} command only---this just forms a variant of the
-@code{gcc} command, so,
-just as the @code{gcc} command itself does not contain the C front end,
-the @code{g77} command does not contain the Fortran front end (FFE).
-The FFE code ends up in an executable named @file{f771},
-which does the actual compiling,
-so it contains the FFE plus the @code{gcc} back end (GBE),
-the latter to do most of the optimization, and the code generation.
-
-The file @file{parse.c} is the source file for @code{yyparse()},
-which is invoked by the GBE to start the compilation process,
-for @file{f771}.
-
-The file @file{top.c} contains the top-level FFE function @code{ffe_file}
-and it (along with top.h) define all @samp{ffe_[a-z].*}, @samp{ffe[A-Z].*},
-and @samp{FFE_[A-Za-z].*} symbols.
-
-The file @file{fini.c} is a @code{main()} program that is used when building
-the FFE to generate C header and source files for recognizing keywords.
-The files @file{malloc.c} and @file{malloc.h} comprise a memory manager
-that defines all @samp{malloc_[a-z].*}, @samp{malloc[A-Z].*}, and
-@samp{MALLOC_[A-Za-z].*} symbols.
-
-All other modules named @var{xyz}
-are comprised of all files named @samp{@var{xyz}*.@var{ext}}
-and define all @samp{ffe@var{xyz}_[a-z].*}, @samp{ffe@var{xyz}[A-Z].*},
-and @samp{FFE@var{XYZ}_[A-Za-z].*} symbols.
-If you understand all this, congratulations---it's easier for me to remember
-how it works than to type in these regular expressions.
-But it does make it easy to find where a symbol is defined.
-For example, the symbol @samp{ffexyz_set_something} would be defined
-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.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.
-
-@item target.c
-@itemx target.h
-These describe the target machine
-in terms of what data types are supported,
-how they are denoted
-(to what C type does an @code{INTEGER*8} map, for example),
-how to convert between them,
-and so on.
-Over time, versions of @code{g77} rely less on this file
-and more on run-time configuration based on GBE info
-in @file{com.c}.
-
-@item com.c
-@itemx com.h
-These are the primary interface to the GBE.
-
-@item ste.c
-@itemx ste.h
-This contains code for implementing recognized executable statements
-in the GBE.
-
-@item src.c
-@itemx src.h
-These contain information on the format(s) of source files
-(such as whether they are never to be processed as case-insensitive
-with regard to Fortran keywords).
-@end table
-
-If you want to debug the @file{f771} executable,
-for example if it crashes,
-note that the global variables @code{lineno} and @code{input_filename}
-are usually set to reflect the current line being read by the lexer
-during the first-pass analysis of a program unit and to reflect
-the current line being processed during the second-pass compilation
-of a program unit.
-
-If an invocation of the function @code{ffestd_exec_end} is on the stack,
-the compiler is in the second pass, otherwise it is in the first.
-
-(This information might help you reduce a test case and/or work around
-a bug in @code{g77} until a fix is available.)
-
-@node Overview of Translation Process
-@section Overview of Translation Process
-
-The order of phases translating source code to the form accepted
-by the GBE is:
-
-@enumerate
-@item
-Stripping punched-card sources (@file{g77stripcard.c})
-
-@item
-Lexing (@file{lex.c})
-
-@item
-Stand-alone statement identification (@file{sta.c})
-
-@item
-INCLUDE handling (@file{sti.c})
-
-@item
-Order-dependent statement identification (@file{stq.c})
-
-@item
-Parsing (@file{stb.c} and @file{expr.c})
-
-@item
-Constructing (@file{stc.c})
-
-@item
-Collecting (@file{std.c})
-
-@item
-Expanding (@file{ste.c})
-@end enumerate
-
-To get a rough idea of how a particularly twisted Fortran statement
-gets treated by the passes, consider:
-
-@smallexample
-      FORMAT(I2 4H)=(J/
-     &   I3)
-@end smallexample
-
-The job of @file{lex.c} is to know enough about Fortran syntax rules
-to break the statement up into distinct lexemes without requiring
-any feedback from subsequent phases:
-
-@smallexample
-`FORMAT'
-`('
-`I24H'
-`)'
-`='
-`('
-`J'
-`/'
-`I3'
-`)'
-@end smallexample
-
-The job of @file{sta.c} is to figure out the kind of statement,
-or, at least, statement form, that sequence of lexemes represent.
-
-The sooner it can do this (in terms of using the smallest number of
-lexemes, starting with the first for each statement), the better,
-because that leaves diagnostics for problems beyond the recognition
-of the statement form to subsequent phases,
-which can usually better describe the nature of the problem.
-
-In this case, the @samp{=} at ``level zero''
-(not nested within parentheses)
-tells @file{sta.c} that this is an @emph{assignment-form},
-not @code{FORMAT}, statement.
-
-An assignment-form statement might be a statement-function
-definition or an executable assignment statement.
-
-To make that determination,
-@file{sta.c} looks at the first two lexemes.
-
-Since the second lexeme is @samp{(},
-the first must represent an array for this to be an assignment statement,
-else it's a statement function.
-
-Either way, @file{sta.c} hands off the statement to @file{stq.c}
-(via @file{sti.c}, which expands INCLUDE files).
-@file{stq.c} figures out what a statement that is,
-on its own, ambiguous, must actually be based on the context
-established by previous statements.
-
-So, @file{stq.c} watches the statement stream for executable statements,
-END statements, and so on, so it knows whether @samp{A(B)=C} is
-(intended as) a statement-function definition or an assignment statement.
-
-After establishing the context-aware statement info, @file{stq.c}
-passes the original sample statement on to @file{stb.c}
-(either its statement-function parser or its assignment-statement parser).
-
-@file{stb.c} forms a
-statement-specific record containing the pertinent information.
-That information includes a source expression and,
-for an assignment statement, a destination expression.
-Expressions are parsed by @file{expr.c}.
-
-This record is passed to @file{stc.c},
-which copes with the implications of the statement
-within the context established by previous statements.
-
-For example, if it's the first statement in the file
-or after an @code{END} statement,
-@file{stc.c} recognizes that, first of all,
-a main program unit is now being lexed
-(and tells that to @file{std.c}
-before telling it about the current statement).
-
-@file{stc.c} attaches whatever information it can,
-usually derived from the context established by the preceding statements,
-and passes the information to @file{std.c}.
-
-@file{std.c} saves this information away,
-since the GBE cannot cope with information
-that might be incomplete at this stage.
-
-For example, @samp{I3} might later be determined
-to be an argument to an alternate @code{ENTRY} point.
-
-When @file{std.c} is told about the end of an external (top-level)
-program unit,
-it passes all the information it has saved away
-on statements in that program unit
-to @file{ste.c}.
-
-@file{ste.c} ``expands'' each statement, in sequence, by
-constructing the appropriate GBE information and calling
-the appropriate GBE routines.
-
-Details on the transformational phases follow.
-Keep in mind that Fortran numbering is used,
-so the first character on a line is column 1,
-decimal numbering is used, and so on.
-
-@menu
-* g77stripcard::
-* lex.c::
-* sta.c::
-* sti.c::
-* stq.c::
-* stb.c::
-* expr.c::
-* stc.c::
-* std.c::
-* ste.c::
-
-* Gotchas (Transforming)::
-* TBD (Transforming)::
-@end menu
-
-@node g77stripcard
-@subsection g77stripcard
-
-The @code{g77stripcard} program handles removing content beyond
-column 72 (adjustable via a command-line option),
-optionally warning about that content being something other
-than trailing whitespace or Fortran commentary.
-
-This program is needed because @code{lex.c} doesn't pay attention
-to maximum line lengths at all, to make it easier to maintain,
-as well as faster (for sources that don't depend on the maximum
-column length vis-a-vis trailing non-blank non-commentary content).
-
-Just how this program will be run---whether automatically for
-old source (perhaps as the default for @file{.f} files?)---is not
-yet determined.
-
-In the meantime, it might as well be implemented as a typical UNIX pipe.
-
-It should accept a @samp{-fline-length-@var{n}} option,
-with the default line length set to 72.
-
-When the text it strips off the end of a line is not blank
-(not spaces and tabs),
-it should insert an additional comment line
-(beginning with @samp{!},
-so it works for both fixed-form and free-form files)
-containing the text,
-following the stripped line.
-The inserted comment should have a prefix of some kind,
-TBD, that distinguishes the comment as representing stripped text.
-Users could use that to @code{sed} out such lines, if they wished---it
-seems silly to provide a command-line option to delete information
-when it can be so easily filtered out by another program.
-
-(This inserted comment should be designed to ``fit in'' well
-with whatever the Fortran community is using these days for
-preprocessor, translator, and other such products, like OpenMP.
-What that's all about, and how @code{g77} can elegantly fit its
-special comment conventions into it all, is TBD as well.
-We don't want to reinvent the wheel here, but if there turn out
-to be too many conflicting conventions, we might have to invent
-one that looks nothing like the others, but which offers their
-host products a better infrastructure in which to fit and coexist
-peacefully.)
-
-@code{g77stripcard} probably shouldn't do any tab expansion or other
-fancy stuff.
-People can use @code{expand} or other pre-filtering if they like.
-The idea here is to keep each stage quite simple, while providing
-excellent performance for ``normal'' code.
-
-(Code with junk beyond column 73 is not really ``normal'',
-as it comes from a card-punch heritage,
-and will be increasingly hard for tomorrow's Fortran programmers to read.)
-
-@node lex.c
-@subsection lex.c
-
-To help make the lexer simple, fast, and easy to maintain,
-while also having @code{g77} generally encourage Fortran programmers
-to write simple, maintainable, portable code by maximizing the
-performance of compiling that kind of code:
-
-@itemize @bullet
-@item
-There'll be just one lexer, for both fixed-form and free-form source.
-
-@item
-It'll care about the form only when handling the first 7 columns of
-text, stuff like spaces between strings of alphanumerics, and
-how lines are continued.
-
-Some other distinctions will be handled by subsequent phases,
-so at least one of them will have to know which form is involved.
-
-For example, @samp{I = 2 . 4} is acceptable in fixed form,
-and works in free form as well given the implementation @code{g77}
-presently uses.
-But the standard requires a diagnostic for it in free form,
-so the parser has to be able to recognize that
-the lexemes aren't contiguous
-(information the lexer @emph{does} have to provide)
-and that free-form source is being parsed,
-so it can provide the diagnostic.
-
-The @code{g77} lexer doesn't try to gather @samp{2 . 4} into a single lexeme.
-Otherwise, it'd have to know a whole lot more about how to parse Fortran,
-or subsequent phases (mainly parsing) would have two paths through
-lots of critical code---one to handle the lexeme @samp{2}, @samp{.},
-and @samp{4} in sequence, another to handle the lexeme @samp{2.4}.
-
-@item
-It won't worry about line lengths
-(beyond the first 7 columns for fixed-form source).
-
-That is, once it starts parsing the ``statement'' part of a line
-(column 7 for fixed-form, column 1 for free-form),
-it'll keep going until it finds a newline,
-rather than ignoring everything past a particular column
-(72 or 132).
-
-The implication here is that there shouldn't @emph{be}
-anything past that last column, other than whitespace or
-commentary, because users using typical editors
-(or viewing output as typically printed)
-won't necessarily know just where the last column is.
-
-Code that has ``garbage'' beyond the last column
-(almost certainly only fixed-form code with a punched-card legacy,
-such as code using columns 73-80 for ``sequence numbers'')
-will have to be run through @code{g77stripcard} first.
-
-Also, keeping track of the maximum column position while also watching out
-for the end of a line @emph{and} while reading from a file
-just makes things slower.
-Since a file must be read, and watching for the end of the line
-is necessary (unless the typical input file was preprocessed to
-include the necessary number of trailing spaces),
-dropping the tracking of the maximum column position
-is the only way to reduce the complexity of the pertinent code
-while maintaining high performance.
-
-@item
-ASCII encoding is assumed for the input file.
-
-Code written in other character sets will have to be converted first.
-
-@item
-Tabs (ASCII code 9)
-will be converted to spaces via the straightforward
-approach.
-
-Specifically, a tab is converted to between one and eight spaces
-as necessary to reach column @var{n},
-where dividing @samp{(@var{n} - 1)} by eight
-results in a remainder of zero.
-
-That saves having to pass most source files through @code{expand}.
-
-@item
-Linefeeds (ASCII code 10)
-mark the ends of lines.
-
-@item
-A carriage return (ASCII code 13)
-is accept if it immediately precedes a linefeed,
-in which case it is ignored.
-
-Otherwise, it is rejected (with a diagnostic).
-
-@item
-Any other characters other than the above
-that are not part of the GNU Fortran Character Set
-(@pxref{Character Set})
-are rejected with a diagnostic.
-
-This includes backspaces, form feeds, and the like.
-
-(It might make sense to allow a form feed in column 1
-as long as that's the only character on a line.
-It certainly wouldn't seem to cost much in terms of performance.)
-
-@item
-The end of the input stream (EOF)
-ends the current line.
-
-@item
-The distinction between uppercase and lowercase letters
-will be preserved.
-
-It will be up to subsequent phases to decide to fold case.
-
-Current plans are to permit any casing for Fortran (reserved) keywords
-while preserving casing for user-defined names.
-(This might not be made the default for @file{.f} files, though.)
-
-Preserving case seems necessary to provide more direct access
-to facilities outside of @code{g77}, such as to C or Pascal code.
-
-Names of intrinsics will probably be matchable in any case,
-
-(How @samp{external SiN; r = sin(x)} would be handled is TBD.
-I think old @code{g77} might already handle that pretty elegantly,
-but whether we can cope with allowing the same fragment to reference
-a @emph{different} procedure, even with the same interface,
-via @samp{s = SiN(r)}, needs to be determined.
-If it can't, we need to make sure that when code introduces
-a user-defined name, any intrinsic matching that name
-using a case-insensitive comparison
-is ``turned off''.)
-
-@item
-Backslashes in @code{CHARACTER} and Hollerith constants
-are not allowed.
-
-This avoids the confusion introduced by some Fortran compiler vendors
-providing C-like interpretation of backslashes,
-while others provide straight-through interpretation.
-
-Some kind of lexical construct (TBD) will be provided to allow
-flagging of a @code{CHARACTER}
-(but probably not a Hollerith)
-constant that permits backslashes.
-It'll necessarily be a prefix, such as:
-
-@smallexample
-PRINT *, C'This line has a backspace \b here.'
-PRINT *, F'This line has a straight backslash \ here.'
-@end smallexample
-
-Further, command-line options might be provided to specify that
-one prefix or the other is to be assumed as the default
-for @code{CHARACTER} constants.
-
-However, it seems more helpful for @code{g77} to provide a program
-that converts prefix all constants
-(or just those containing backslashes)
-with the desired designation,
-so printouts of code can be read
-without knowing the compile-time options used when compiling it.
-
-If such a program is provided
-(let's name it @code{g77slash} for now),
-then a command-line option to @code{g77} should not be provided.
-(Though, given that it'll be easy to implement, it might be hard
-to resist user requests for it ``to compile faster than if we
-have to invoke another filter''.)
-
-This program would take a command-line option to specify the
-default interpretation of slashes,
-affecting which prefix it uses for constants.
-
-@code{g77slash} probably should automatically convert Hollerith
-constants that contain slashes
-to the appropriate @code{CHARACTER} constants.
-Then @code{g77} wouldn't have to define a prefix syntax for Hollerith
-constants specifying whether they want C-style or straight-through
-backslashes.
-
-@item
-To allow for form-neutral INCLUDE files without requiring them
-to be preprocessed,
-the fixed-form lexer should offer an extension (if possible)
-allowing a trailing @samp{&} to be ignored, especially if after
-column 72, as it would be using the traditional Unix Fortran source
-model (which ignores @emph{everything} after column 72).
-@end itemize
-
-The above implements nearly exactly what is specified by
-@ref{Character Set},
-and
-@ref{Lines},
-except it also provides automatic conversion of tabs
-and ignoring of newline-related carriage returns,
-as well as accommodating form-neutral INCLUDE files.
-
-It also implements the ``pure visual'' model,
-by which is meant that a user viewing his code
-in a typical text editor
-(assuming it's not preprocessed via @code{g77stripcard} or similar)
-doesn't need any special knowledge
-of whether spaces on the screen are really tabs,
-whether lines end immediately after the last visible non-space character
-or after a number of spaces and tabs that follow it,
-or whether the last line in the file is ended by a newline.
-
-Most editors don't make these distinctions,
-the ANSI FORTRAN 77 standard doesn't require them to,
-and it permits a standard-conforming compiler
-to define a method for transforming source code to
-``standard form'' however it wants.
-
-So, GNU Fortran defines it such that users have the best chance
-of having the code be interpreted the way it looks on the screen
-of the typical editor.
-
-(Fancy editors should @emph{never} be required to correctly read code
-written in classic two-dimensional-plaintext form.
-By correct reading I mean ability to read it, book-like, without
-mistaking text ignored by the compiler for program code and vice versa,
-and without having to count beyond the first several columns.
-The vague meaning of ASCII TAB, among other things, complicates
-this somewhat, but as long as ``everyone'', including the editor,
-other tools, and printer, agrees about the every-eighth-column convention,
-the GNU Fortran ``pure visual'' model meets these requirements.
-Any language or user-visible source form
-requiring special tagging of tabs,
-the ends of lines after spaces/tabs,
-and so on, fails to meet this fairly straightforward specification.
-Fortunately, Fortran @emph{itself} does not mandate such a failure,
-though most vendor-supplied defaults for their Fortran compilers @emph{do}
-fail to meet this specification for readability.)
-
-Further, this model provides a clean interface
-to whatever preprocessors or code-generators are used
-to produce input to this phase of @code{g77}.
-Mainly, they need not worry about long lines.
-
-@node sta.c
-@subsection sta.c
-
-@node sti.c
-@subsection sti.c
-
-@node stq.c
-@subsection stq.c
-
-@node stb.c
-@subsection stb.c
-
-@node expr.c
-@subsection expr.c
-
-@node stc.c
-@subsection stc.c
-
-@node std.c
-@subsection std.c
-
-@node ste.c
-@subsection ste.c
-
-@node Gotchas (Transforming)
-@subsection Gotchas (Transforming)
-
-This section is not about transforming ``gotchas'' into something else.
-It is about the weirder aspects of transforming Fortran,
-however that's defined,
-into a more modern, canonical form.
-
-@subsubsection Multi-character Lexemes
-
-Each lexeme carries with it a pointer to where it appears in the source.
-
-To provide the ability for diagnostics to point to column numbers,
-in addition to line numbers and names,
-lexemes that represent more than one (significant) character
-in the source code need, generally,
-to provide pointers to where each @emph{character} appears in the source.
-
-This provides the ability to properly identify the precise location
-of the problem in code like
-
-@smallexample
-SUBROUTINE X
-END
-BLOCK DATA X
-END
-@end smallexample
-
-which, in fixed-form source, would result in single lexemes
-consisting of the strings @samp{SUBROUTINEX} and @samp{BLOCKDATAX}.
-(The problem is that @samp{X} is defined twice,
-so a pointer to the @samp{X} in the second definition,
-as well as a follow-up pointer to the corresponding pointer in the first,
-would be preferable to pointing to the beginnings of the statements.)
-
-This need also arises when parsing (and diagnosing) @code{FORMAT}
-statements.
-
-Further, it arises when diagnosing
-@code{FMT=} specifiers that contain constants
-(or partial constants, or even propagated constants!)
-in I/O statements, as in:
-
-@smallexample
-PRINT '(I2, 3HAB)', J
-@end smallexample
-
-(A pointer to the beginning of the prematurely-terminated Hollerith
-constant, and/or to the close parenthese, is preferable to a pointer
-to the open-parenthese or the apostrophe that precedes it.)
-
-Multi-character lexemes, which would seem to naturally include
-at least digit strings, alphanumeric strings, @code{CHARACTER}
-constants, and Hollerith constants, therefore need to provide
-location information on each character.
-(Maybe Hollerith constants don't, but it's unnecessary to except them.)
-
-The question then arises, what about @emph{other} multi-character lexemes,
-such as @samp{**} and @samp{//},
-and Fortran 90's @samp{(/}, @samp{/)}, @samp{::}, and so on?
-
-Turns out there's a need to identify the location of the second character
-of these two-character lexemes.
-For example, in @samp{I(/J) = K}, the slash needs to be diagnosed
-as the problem, not the open parenthese.
-Similarly, it is preferable to diagnose the second slash in
-@samp{I = J // K} rather than the first, given the implicit typing
-rules, which would result in the compiler disallowing the attempted
-concatenation of two integers.
-(Though, since that's more of a semantic issue,
-it's not @emph{that} much preferable.)
-
-Even sequences that could be parsed as digit strings could use location info,
-for example, to diagnose the @samp{9} in the octal constant @samp{O'129'}.
-(This probably will be parsed as a character string,
-to be consistent with the parsing of @samp{Z'129A'}.)
-
-To avoid the hassle of recording the location of the second character,
-while also preserving the general rule that each significant character
-is distinctly pointed to by the lexeme that contains it,
-it's best to simply not have any fixed-size lexemes
-larger than one character.
-
-This new design is expected to make checking for two
-@samp{*} lexemes in a row much easier than the old design,
-so this is not much of a sacrifice.
-It probably makes the lexer much easier to implement
-than it makes the parser harder.
-
-@subsubsection Space-padding Lexemes
-
-Certain lexemes need to be padded with virtual spaces when the
-end of the line (or file) is encountered.
-
-This is necessary in fixed form, to handle lines that don't
-extend to column 72, assuming that's the line length in effect.
-
-@subsubsection Bizarre Free-form Hollerith Constants
-
-Last I checked, the Fortran 90 standard actually required the compiler
-to silently accept something like
-
-@smallexample
-FORMAT ( 1 2   Htwelve chars )
-@end smallexample
-
-as a valid @code{FORMAT} statement specifying a twelve-character
-Hollerith constant.
-
-The implication here is that, since the new lexer is a zero-feedback one,
-it won't know that the special case of a @code{FORMAT} statement being parsed
-requires apparently distinct lexemes @samp{1} and @samp{2} to be treated as
-a single lexeme.
-
-(This is a horrible misfeature of the Fortran 90 language.
-It's one of many such misfeatures that almost make me want
-to not support them, and forge ahead with designing a new
-``GNU Fortran'' language that has the features,
-but not the misfeatures, of Fortran 90,
-and provide utility programs to do the conversion automatically.)
-
-So, the lexer must gather distinct chunks of decimal strings into
-a single lexeme in contexts where a single decimal lexeme might
-start a Hollerith constant.
-
-(Which probably means it might as well do that all the time
-for all multi-character lexemes, even in free-form mode,
-leaving it to subsequent phases to pull them apart as they see fit.)
-
-Compare the treatment of this to how
-
-@smallexample
-CHARACTER * 4 5 HEY
-@end smallexample
-
-and
-
-@smallexample
-CHARACTER * 12 HEY
-@end smallexample
-
-must be treated---the former must be diagnosed, due to the separation
-between lexemes, the latter must be accepted as a proper declaration.
-
-@subsubsection Hollerith Constants
-
-Recognizing a Hollerith constant---specifically,
-that an @samp{H} or @samp{h} after a digit string begins
-such a constant---requires some knowledge of context.
-
-Hollerith constants (such as @samp{2HAB}) can appear after:
-
-@itemize @bullet
-@item
-@samp{(}
-
-@item
-@samp{,}
-
-@item
-@samp{=}
-
-@item
-@samp{+}, @samp{-}, @samp{/}
-
-@item
-@samp{*}, except as noted below
-@end itemize
-
-Hollerith constants don't appear after:
-
-@itemize @bullet
-@item
-@samp{CHARACTER*},
-which can be treated generally as
-any @samp{*} that is the second lexeme of a statement
-@end itemize
-
-@subsubsection Confusing Function Keyword
-
-While
-
-@smallexample
-REAL FUNCTION FOO ()
-@end smallexample
-
-must be a @code{FUNCTION} statement and
-
-@smallexample
-REAL FUNCTION FOO (5)
-@end smallexample
-
-must be a type-definition statement,
-
-@smallexample
-REAL FUNCTION FOO (@var{names})
-@end smallexample
-
-where @var{names} is a comma-separated list of names,
-can be one or the other.
-
-The only way to disambiguate that statement
-(short of mandating free-form source or a short maximum
-length for name for external procedures)
-is based on the context of the statement.
-
-In particular, the statement is known to be within an
-already-started program unit
-(but not at the outer level of the @code{CONTAINS} block),
-it is a type-declaration statement.
-
-Otherwise, the statement is a @code{FUNCTION} statement,
-in that it begins a function program unit
-(external, or, within @code{CONTAINS}, nested).
-
-@subsubsection Weird READ
-
-The statement
-
-@smallexample
-READ (N)
-@end smallexample
-
-is equivalent to either
-
-@smallexample
-READ (UNIT=(N))
-@end smallexample
-
-or
-
-@smallexample
-READ (FMT=(N))
-@end smallexample
-
-depending on which would be valid in context.
-
-Specifically, if @samp{N} is type @code{INTEGER},
-@samp{READ (FMT=(N))} would not be valid,
-because parentheses may not be used around @samp{N},
-whereas they may around it in @samp{READ (UNIT=(N))}.
-
-Further, if @samp{N} is type @code{CHARACTER},
-the opposite is true---@samp{READ (UNIT=(N))} is not valid,
-but @samp{READ (FMT=(N))} is.
-
-Strictly speaking, if anything follows
-
-@smallexample
-READ (N)
-@end smallexample
-
-in the statement, whether the first lexeme after the close
-parenthese is a comma could be used to disambiguate the two cases,
-without looking at the type of @samp{N},
-because the comma is required for the @samp{READ (FMT=(N))}
-interpretation and disallowed for the @samp{READ (UNIT=(N))}
-interpretation.
-
-However, in practice, many Fortran compilers allow
-the comma for the @samp{READ (UNIT=(N))}
-interpretation anyway
-(in that they generally allow a leading comma before
-an I/O list in an I/O statement),
-and much code takes advantage of this allowance.
-
-(This is quite a reasonable allowance, since the
-juxtaposition of a comma-separated list immediately
-after an I/O control-specification list, which is also comma-separated,
-without an intervening comma,
-looks sufficiently ``wrong'' to programmers
-that they can't resist the itch to insert the comma.
-@samp{READ (I, J), K, L} simply looks cleaner than
-@samp{READ (I, J) K, L}.)
-
-So, type-based disambiguation is needed unless strict adherence
-to the standard is always assumed, and we're not going to assume that.
-
-@node TBD (Transforming)
-@subsection TBD (Transforming)
-
-Continue researching gotchas, designing the transformational process,
-and implementing it.
-
-Specific issues to resolve:
-
-@itemize @bullet
-@item
-Just where should (if it was implemented) @code{USE} processing take place?
-
-This gets into the whole issue of how @code{g77} should handle the concept
-of modules.
-I think GNAT already takes on this issue, but don't know more than that.
-Jim Giles has written extensively on @code{comp.lang.fortran}
-about his opinions on module handling, as have others.
-Jim's views should be taken into account.
-
-Actually, Richard M. Stallman (RMS) also has written up
-some guidelines for implementing such things,
-but I'm not sure where I read them.
-Perhaps the old @email{gcc2@@cygnus.com} list.
-
-If someone could dig references to these up and get them to me,
-that would be much appreciated!
-Even though modules are not on the short-term list for implementation,
-it'd be helpful to know @emph{now} how to avoid making them harder to
-implement them @emph{later}.
-
-@item
-Should the @code{g77} command become just a script that invokes
-all the various preprocessing that might be needed,
-thus making it seem slower than necessary for legacy code
-that people are unwilling to convert,
-or should we provide a separate script for that,
-thus encouraging people to convert their code once and for all?
-
-At least, a separate script to behave as old @code{g77} did,
-perhaps named @code{g77old}, might ease the transition,
-as might a corresponding one that converts source codes
-named @code{g77oldnew}.
-
-These scripts would take all the pertinent options @code{g77} used
-to take and run the appropriate filters,
-passing the results to @code{g77} or just making new sources out of them
-(in a subdirectory, leaving the user to do the dirty deed of
-moving or copying them over the old sources).
-
-@item
-Do other Fortran compilers provide a prefix syntax
-to govern the treatment of backslashes in @code{CHARACTER}
-(or Hollerith) constants?
-
-Knowing what other compilers provide would help.
-
-@item
-Is it okay to drop support for the @samp{-fintrin-case-initcap},
-@samp{-fmatch-case-initcap}, @samp{-fsymbol-case-initcap},
-and @samp{-fcase-initcap} options?
-
-I've asked @email{info-gnu-fortran@@gnu.org} for input on this.
-Not having to support these makes it easier to write the new front end,
-and might also avoid complicated its design.
-
-The consensus to date (1999-11-17) has been to drop this support.
-Can't recall anybody saying they're using it, in fact.
-@end itemize
-
-@node Philosophy of Code Generation
-@section Philosophy of Code Generation
-
-Don't poke the bear.
-
-The @code{g77} front end generates code
-via the @code{gcc} back end.
-
-@cindex GNU Back End (GBE)
-@cindex GBE
-@cindex @code{gcc}, back end
-@cindex back end, gcc
-@cindex code generator
-The @code{gcc} back end (GBE) is a large, complex
-labyrinth of intricate code
-written in a combination of the C language
-and specialized languages internal to @code{gcc}.
-
-While the @emph{code} that implements the GBE
-is written in a combination of languages,
-the GBE itself is,
-to the front end for a language like Fortran,
-best viewed as a @emph{compiler}
-that compiles its own, unique, language.
-
-The GBE's ``source'', then, is written in this language,
-which consists primarily of
-a combination of calls to GBE functions
-and @dfn{tree} nodes
-(which are, themselves, created
-by calling GBE functions).
-
-So, the @code{g77} generates code by, in effect,
-translating the Fortran code it reads
-into a form ``written'' in the ``language''
-of the @code{gcc} back end.
-
-@cindex GBEL
-@cindex GNU Back End Language (GBEL)
-This language will heretofore be referred to as @dfn{GBEL},
-for GNU Back End Language.
-
-GBEL is an evolving language,
-not fully specified in any published form
-as of this writing.
-It offers many facilities,
-but its ``core'' facilities
-are those that corresponding most directly
-to those needed to support @code{gcc}
-(compiling code written in GNU C).
-
-The @code{g77} Fortran Front End (FFE)
-is designed and implemented
-to navigate the currents and eddies
-of ongoing GBEL and @code{gcc} development
-while also delivering on the potential
-of an integrated FFE
-(as compared to using a converter like @code{f2c}
-and feeding the output into @code{gcc}).
-
-Goals of the FFE's code-generation strategy include:
-
-@itemize @bullet
-@item
-High likelihood of generation of correct code,
-or, failing that, producing a fatal diagnostic or crashing.
-
-@item
-Generation of highly optimized code,
-as directed by the user
-via GBE-specific (versus @code{g77}-specific) constructs,
-such as command-line options.
-
-@item
-Fast overall (FFE plus GBE) compilation.
-
-@item
-Preservation of source-level debugging information.
-@end itemize
-
-The strategies historically, and currently, used by the FFE
-to achieve these goals include:
-
-@itemize @bullet
-@item
-Use of GBEL constructs that most faithfully encapsulate
-the semantics of Fortran.
-
-@item
-Avoidance of GBEL constructs that are so rarely used,
-or limited to use in specialized situations not related to Fortran,
-that their reliability and performance has not yet been established
-as sufficient for use by the FFE.
-
-@item
-Flexible design, to readily accommodate changes to specific
-code-generation strategies, perhaps governed by command-line options.
-@end itemize
-
-@cindex Bear-poking
-@cindex Poking the bear
-``Don't poke the bear'' somewhat summarizes the above strategies.
-The GBE is the bear.
-The FFE is designed and implemented to avoid poking it
-in ways that are likely to just annoy it.
-The FFE usually either tackles it head-on,
-or avoids treating it in ways dissimilar to how
-the @code{gcc} front end treats it.
-
-For example, the FFE uses the native array facility in the back end
-instead of the lower-level pointer-arithmetic facility
-used by @code{gcc} when compiling @code{f2c} output).
-Theoretically, this presents more opportunities for optimization,
-faster compile times,
-and the production of more faithful debugging information.
-These benefits were not, however, immediately realized,
-mainly because @code{gcc} itself makes little or no use
-of the native array facility.
-
-Complex arithmetic is a case study of the evolution of this strategy.
-When originally implemented,
-the GBEL had just evolved its own native complex-arithmetic facility,
-so the FFE took advantage of that.
-
-When porting @code{g77} to 64-bit systems,
-it was discovered that the GBE didn't really
-implement its native complex-arithmetic facility properly.
-
-The short-term solution was to rewrite the FFE
-to instead use the lower-level facilities
-that'd be used by @code{gcc}-compiled code
-(assuming that code, itself, didn't use the native complex type
-provided, as an extension, by @code{gcc}),
-since these were known to work,
-and, in any case, if shown to not work,
-would likely be rapidly fixed
-(since they'd likely not work for vanilla C code in similar circumstances).
-
-However, the rewrite accommodated the original, native approach as well
-by offering a command-line option to select it over the emulated approach.
-This allowed users, and especially GBE maintainers, to try out
-fixes to complex-arithmetic support in the GBE
-while @code{g77} continued to default to compiling more code correctly,
-albeit producing (typically) slower executables.
-
-As of April 1999, it appeared that the last few bugs
-in the GBE's support of its native complex-arithmetic facility
-were worked out.
-The FFE was changed back to default to using that native facility,
-leaving emulation as an option.
-
-Later during the release cycle
-(which was called EGCS 1.2, but soon became GCC 2.95),
-bugs in the native facility were found.
-Reactions among various people included
-``the last thing we should do is change the default back'',
-``we must change the default back'',
-and ``let's figure out whether we can narrow down the bugs to
-few enough cases to allow the now-months-long-tested default
-to remain the same''.
-The latter viewpoint won that particular time.
-The bugs exposed other concerns regarding ABI compliance
-when the ABI specified treatment of complex data as different
-from treatment of what Fortran and GNU C consider the equivalent
-aggregation (structure) of real (or float) pairs.
-
-Other Fortran constructs---arrays, character strings,
-complex division, @code{COMMON} and @code{EQUIVALENCE} aggregates,
-and so on---involve issues similar to those pertaining to complex arithmetic.
-
-So, it is possible that the history
-of how the FFE handled complex arithmetic
-will be repeated, probably in modified form
-(and hopefully over shorter timeframes),
-for some of these other facilities.
-
-@node Two-pass Design
-@section Two-pass Design
-
-The FFE does not tell the GBE anything about a program unit
-until after the last statement in that unit has been parsed.
-(A program unit is a Fortran concept that corresponds, in the C world,
-mostly closely to functions definitions in ISO C.
-That is, a program unit in Fortran is like a top-level function in C.
-Nested functions, found among the extensions offered by GNU C,
-correspond roughly to Fortran's statement functions.)
-
-So, while parsing the code in a program unit,
-the FFE saves up all the information
-on statements, expressions, names, and so on,
-until it has seen the last statement.
-
-At that point, the FFE revisits the saved information
-(in what amounts to a second @dfn{pass} over the program unit)
-to perform the actual translation of the program unit into GBEL,
-ultimating in the generation of assembly code for it.
-
-Some lookahead is performed during this second pass,
-so the FFE could be viewed as a ``two-plus-pass'' design.
-
-@menu
-* Two-pass Code::
-* Why Two Passes::
-@end menu
-
-@node Two-pass Code
-@subsection Two-pass Code
-
-Most of the code that turns the first pass (parsing)
-into a second pass for code generation
-is in @file{@value{path-g77}/std.c}.
-
-It has external functions,
-called mainly by siblings in @file{@value{path-g77}/stc.c},
-that record the information on statements and expressions
-in the order they are seen in the source code.
-These functions save that information.
-
-It also has an external function that revisits that information,
-calling the siblings in @file{@value{path-g77}/ste.c},
-which handles the actual code generation
-(by generating GBEL code,
-that is, by calling GBE routines
-to represent and specify expressions, statements, and so on).
-
-@node Why Two Passes
-@subsection Why Two Passes
-
-The need for two passes was not immediately evident
-during the design and implementation of the code in the FFE
-that was to produce GBEL.
-Only after a few kludges,
-to handle things like incorrectly-guessed @code{ASSIGN} label nature,
-had been implemented,
-did enough evidence pile up to make it clear
-that @file{std.c} had to be introduced to intercept,
-save, then revisit as part of a second pass,
-the digested contents of a program unit.
-
-Other such missteps have occurred during the evolution of the FFE,
-because of the different goals of the FFE and the GBE.
-
-Because the GBE's original, and still primary, goal
-was to directly support the GNU C language,
-the GBEL, and the GBE itself,
-requires more complexity
-on the part of most front ends
-than it requires of @code{gcc}'s.
-
-For example,
-the GBEL offers an interface that permits the @code{gcc} front end
-to implement most, or all, of the language features it supports,
-without the front end having to
-make use of non-user-defined variables.
-(It's almost certainly the case that all of K&R C,
-and probably ANSI C as well,
-is handled by the @code{gcc} front end
-without declaring such variables.)
-
-The FFE, on the other hand, must resort to a variety of ``tricks''
-to achieve its goals.
-
-Consider the following C code:
-
-@smallexample
-int
-foo (int a, int b)
-@{
-  int c = 0;
-
-  if ((c = bar (c)) == 0)
-    goto done;
-
-  quux (c << 1);
-
-done:
-  return c;
-@}
-@end smallexample
-
-Note what kinds of objects are declared, or defined, before their use,
-and before any actual code generation involving them
-would normally take place:
-
-@itemize @bullet
-@item
-Return type of function
-
-@item
-Entry point(s) of function
-
-@item
-Dummy arguments
-
-@item
-Variables
-
-@item
-Initial values for variables
-@end itemize
-
-Whereas, the following items can, and do,
-suddenly appear ``out of the blue'' in C:
-
-@itemize @bullet
-@item
-Label references
-
-@item
-Function references
-@end itemize
-
-Not surprisingly, the GBE faithfully permits the latter set of items
-to be ``discovered'' partway through GBEL ``programs'',
-just as they are permitted to in C.
-
-Yet, the GBE has tended, at least in the past,
-to be reticent to fully support similar ``late'' discovery
-of items in the former set.
-
-This makes Fortran a poor fit for the ``safe'' subset of GBEL.
-Consider:
-
-@smallexample
-      FUNCTION X (A, ARRAY, ID1)
-      CHARACTER*(*) A
-      DOUBLE PRECISION X, Y, Z, TMP, EE, PI
-      REAL ARRAY(ID1*ID2)
-      COMMON ID2
-      EXTERNAL FRED
-
-      ASSIGN 100 TO J
-      CALL FOO (I)
-      IF (I .EQ. 0) PRINT *, A(0)
-      GOTO 200
-
-      ENTRY Y (Z)
-      ASSIGN 101 TO J
-200   PRINT *, A(1)
-      READ *, TMP
-      GOTO J
-100   X = TMP * EE
-      RETURN
-101   Y = TMP * PI
-      CALL FRED
-      DATA EE, PI /2.71D0, 3.14D0/
-      END
-@end smallexample
-
-Here are some observations about the above code,
-which, while somewhat contrived,
-conforms to the FORTRAN 77 and Fortran 90 standards:
-
-@itemize @bullet
-@item
-The return type of function @samp{X} is not known
-until the @samp{DOUBLE PRECISION} line has been parsed.
-
-@item
-Whether @samp{A} is a function or a variable
-is not known until the @samp{PRINT *, A(0)} statement
-has been parsed.
-
-@item
-The bounds of the array of argument @samp{ARRAY}
-depend on a computation involving
-the subsequent argument @samp{ID1}
-and the blank-common member @samp{ID2}.
-
-@item
-Whether @samp{Y} and @samp{Z} are local variables,
-additional function entry points,
-or dummy arguments to additional entry points
-is not known
-until the @code{ENTRY} statement is parsed.
-
-@item
-Similarly, whether @samp{TMP} is a local variable is not known
-until the @samp{READ *, TMP} statement is parsed.
-
-@item
-The initial values for @samp{EE} and @samp{PI}
-are not known until after the @code{DATA} statement is parsed.
-
-@item
-Whether @samp{FRED} is a function returning type @code{REAL}
-or a subroutine
-(which can be thought of as returning type @code{void}
-@emph{or}, to support alternate returns in a simple way,
-type @code{int})
-is not known
-until the @samp{CALL FRED} statement is parsed.
-
-@item
-Whether @samp{100} is a @code{FORMAT} label
-or the label of an executable statement
-is not known
-until the @samp{X =} statement is parsed.
-(These two types of labels get @emph{very} different treatment,
-especially when @code{ASSIGN}'ed.)
-
-@item
-That @samp{J} is a local variable is not known
-until the first @code{ASSIGN} statement is parsed.
-(This happens @emph{after} executable code has been seen.)
-@end itemize
-
-Very few of these ``discoveries''
-can be accommodated by the GBE as it has evolved over the years.
-The GBEL doesn't support several of them,
-and those it might appear to support
-don't always work properly,
-especially in combination with other GBEL and GBE features,
-as implemented in the GBE.
-
-(Had the GBE and its GBEL originally evolved to support @code{g77},
-the shoe would be on the other foot, so to speak---most, if not all,
-of the above would be directly supported by the GBEL,
-and a few C constructs would probably not, as they are in reality,
-be supported.
-Both this mythical, and today's real, GBE caters to its GBEL
-by, sometimes, scrambling around, cleaning up after itself---after
-discovering that assumptions it made earlier during code generation
-are incorrect.
-That's not a great design, since it indicates significant code
-paths that might be rarely tested but used in some key production
-environments.)
-
-So, the FFE handles these discrepancies---between the order in which
-it discovers facts about the code it is compiling,
-and the order in which the GBEL and GBE support such discoveries---by
-performing what amounts to two
-passes over each program unit.
-
-(A few ambiguities can remain at that point,
-such as whether, given @samp{EXTERNAL BAZ}
-and no other reference to @samp{BAZ} in the program unit,
-it is a subroutine, a function, or a block-data---which, in C-speak,
-governs its declared return type.
-Fortunately, these distinctions are easily finessed
-for the procedure, library, and object-file interfaces
-supported by @code{g77}.)
-
-@node Challenges Posed
-@section Challenges Posed
-
-Consider the following Fortran code, which uses various extensions
-(including some to Fortran 90):
-
-@smallexample
-SUBROUTINE X(A)
-CHARACTER*(*) A
-COMPLEX CFUNC
-INTEGER*2 CLOCKS(200)
-INTEGER IFUNC
-
-CALL SYSTEM_CLOCK (CLOCKS (IFUNC (CFUNC ('('//A//')'))))
-@end smallexample
-
-The above poses the following challenges to any Fortran compiler
-that uses run-time interfaces, and a run-time library, roughly similar
-to those used by @code{g77}:
-
-@itemize @bullet
-@item
-Assuming the library routine that supports @code{SYSTEM_CLOCK}
-expects to set an @code{INTEGER*4} variable via its @code{COUNT} argument,
-the compiler must make available to it a temporary variable of that type.
-
-@item
-Further, after the @code{SYSTEM_CLOCK} library routine returns,
-the compiler must ensure that the temporary variable it wrote
-is copied into the appropriate element of the @samp{CLOCKS} array.
-(This assumes the compiler doesn't just reject the code,
-which it should if it is compiling under some kind of a ``strict'' option.)
-
-@item
-To determine the correct index into the @samp{CLOCKS} array,
-(putting aside the fact that the index, in this particular case,
-need not be computed until after
-the @code{SYSTEM_CLOCK} library routine returns),
-the compiler must ensure that the @code{IFUNC} function is called.
-
-That requires evaluating its argument,
-which requires, for @code{g77}
-(assuming @code{-ff2c} is in force),
-reserving a temporary variable of type @code{COMPLEX}
-for use as a repository for the return value
-being computed by @samp{CFUNC}.
-
-@item
-Before invoking @samp{CFUNC},
-is argument must be evaluated,
-which requires allocating, at run time,
-a temporary large enough to hold the result of the concatenation,
-as well as actually performing the concatenation.
-
-@item
-The large temporary needed during invocation of @code{CFUNC}
-should, ideally, be deallocated
-(or, at least, left to the GBE to dispose of, as it sees fit)
-as soon as @code{CFUNC} returns,
-which means before @code{IFUNC} is called
-(as it might need a lot of dynamically allocated memory).
-@end itemize
-
-@code{g77} currently doesn't support all of the above,
-but, so that it might someday, it has evolved to handle
-at least some of the above requirements.
-
-Meeting the above requirements is made more challenging
-by conforming to the requirements of the GBEL/GBE combination.
-
-@node Transforming Statements
-@section Transforming Statements
-
-Most Fortran statements are given their own block,
-and, for temporary variables they might need, their own scope.
-(A block is what distinguishes @samp{@{ foo (); @}}
-from just @samp{foo ();} in C.
-A scope is included with every such block,
-providing a distinct name space for local variables.)
-
-Label definitions for the statement precede this block,
-so @samp{10 PRINT *, I} is handled more like
-@samp{fl10: @{ @dots{} @}} than @samp{@{ fl10: @dots{} @}}
-(where @samp{fl10} is just a notation meaning ``Fortran Label 10''
-for the purposes of this document).
-
-@menu
-* Statements Needing Temporaries::
-* Transforming DO WHILE::
-* Transforming Iterative DO::
-* Transforming Block IF::
-* Transforming SELECT CASE::
-@end menu
-
-@node Statements Needing Temporaries
-@subsection Statements Needing Temporaries
-
-Any temporaries needed during, but not beyond,
-execution of a Fortran statement,
-are made local to the scope of that statement's block.
-
-This allows the GBE to share storage for these temporaries
-among the various statements without the FFE
-having to manage that itself.
-
-(The GBE could, of course, decide to optimize 
-management of these temporaries.
-For example, it could, theoretically,
-schedule some of the computations involving these temporaries
-to occur in parallel.
-More practically, it might leave the storage for some temporaries
-``live'' beyond their scopes, to reduce the number of
-manipulations of the stack pointer at run time.)
-
-Temporaries needed across distinct statement boundaries usually
-are associated with Fortran blocks (such as @code{DO}/@code{END DO}).
-(Also, there might be temporaries not associated with blocks at all---these
-would be in the scope of the entire program unit.)
-
-Each Fortran block @emph{should} get its own block/scope in the GBE.
-This is best, because it allows temporaries to be more naturally handled.
-However, it might pose problems when handling labels
-(in particular, when they're the targets of @code{GOTO}s outside the Fortran
-block), and generally just hassling with replicating
-parts of the @code{gcc} front end
-(because the FFE needs to support
-an arbitrary number of nested back-end blocks
-if each Fortran block gets one).
-
-So, there might still be a need for top-level temporaries, whose
-``owning'' scope is that of the containing procedure.
-
-Also, there seems to be problems declaring new variables after
-generating code (within a block) in the back end, leading to, e.g.,
-@samp{label not defined before binding contour} or similar messages,
-when compiling with @samp{-fstack-check} or
-when compiling for certain targets.
-
-Because of that, and because sometimes these temporaries are not
-discovered until in the middle of of generating code for an expression
-statement (as in the case of the optimization for @samp{X**I}),
-it seems best to always
-pre-scan all the expressions that'll be expanded for a block
-before generating any of the code for that block.
-
-This pre-scan then handles discovering and declaring, to the back end,
-the temporaries needed for that block.
-
-It's also important to treat distinct items in an I/O list as distinct
-statements deserving their own blocks.
-That's because there's a requirement
-that each I/O item be fully processed before the next one,
-which matters in cases like @samp{READ (*,*), I, A(I)}---the
-element of @samp{A} read in the second item
-@emph{must} be determined from the value
-of @samp{I} read in the first item.
-
-@node Transforming DO WHILE
-@subsection Transforming DO WHILE
-
-@samp{DO WHILE(expr)} @emph{must} be implemented
-so that temporaries needed to evaluate @samp{expr}
-are generated just for the test, each time.
-
-Consider how @samp{DO WHILE (A//B .NE. 'END'); @dots{}; END DO} is transformed:
-
-@smallexample
-for (;;)
-  @{
-    int temp0;
-
-    @{
-      char temp1[large];
-
-      libg77_catenate (temp1, a, b);
-      temp0 = libg77_ne (temp1, 'END');
-    @}
-
-    if (! temp0)
-      break;
-
-    @dots{}
-  @}
-@end smallexample
-
-In this case, it seems like a time/space tradeoff
-between allocating and deallocating @samp{temp1} for each iteration
-and allocating it just once for the entire loop.
-
-However, if @samp{temp1} is allocated just once for the entire loop,
-it could be the wrong size for subsequent iterations of that loop
-in cases like @samp{DO WHILE (A(I:J)//B .NE. 'END')},
-because the body of the loop might modify @samp{I} or @samp{J}.
-
-So, the above implementation is used,
-though a more optimal one can be used
-in specific circumstances.
-
-@node Transforming Iterative DO
-@subsection Transforming Iterative DO
-
-An iterative @code{DO} loop
-(one that specifies an iteration variable)
-is required by the Fortran standards
-to be implemented as though an iteration count
-is computed before entering the loop body,
-and that iteration count used to determine
-the number of times the loop body is to be performed
-(assuming the loop isn't cut short via @code{GOTO} or @code{EXIT}).
-
-The FFE handles this by allocating a temporary variable
-to contain the computed number of iterations.
-Since this variable must be in a scope that includes the entire loop,
-a GBEL block is created for that loop,
-and the variable declared as belonging to the scope of that block.
-
-@node Transforming Block IF
-@subsection Transforming Block IF
-
-Consider:
-
-@smallexample
-SUBROUTINE X(A,B,C)
-CHARACTER*(*) A, B, C
-LOGICAL LFUNC
-
-IF (LFUNC (A//B)) THEN
-  CALL SUBR1
-ELSE IF (LFUNC (A//C)) THEN
-  CALL SUBR2
-ELSE
-  CALL SUBR3
-END
-@end smallexample
-
-The arguments to the two calls to @samp{LFUNC}
-require dynamic allocation (at run time),
-but are not required during execution of the @code{CALL} statements.
-
-So, the scopes of those temporaries must be within blocks inside
-the block corresponding to the Fortran @code{IF} block.
-
-This cannot be represented ``naturally''
-in vanilla C, nor in GBEL.
-The @code{if}, @code{elseif}, @code{else},
-and @code{endif} constructs
-provided by both languages must,
-for a given @code{if} block,
-share the same C/GBE block.
-
-Therefore, any temporaries needed during evaluation of @samp{expr}
-while executing @samp{ELSE IF(expr)}
-must either have been predeclared
-at the top of the corresponding @code{IF} block,
-or declared within a new block for that @code{ELSE IF}---a block that,
-since it cannot contain the @code{else} or @code{else if} itself
-(due to the above requirement),
-actually implements the rest of the @code{IF} block's
-@code{ELSE IF} and @code{ELSE} statements
-within an inner block.
-
-The FFE takes the latter approach.
-
-@node Transforming SELECT CASE
-@subsection Transforming SELECT CASE
-
-@code{SELECT CASE} poses a few interesting problems for code generation,
-if efficiency and frugal stack management are important.
-
-Consider @samp{SELECT CASE (I('PREFIX'//A))},
-where @samp{A} is @code{CHARACTER*(*)}.
-In a case like this---basically,
-in any case where largish temporaries are needed
-to evaluate the expression---those temporaries should
-not be ``live'' during execution of any of the @code{CASE} blocks.
-
-So, evaluation of the expression is best done within its own block,
-which in turn is within the @code{SELECT CASE} block itself
-(which contains the code for the CASE blocks as well,
-though each within their own block).
-
-Otherwise, we'd have the rough equivalent of this pseudo-code:
-
-@smallexample
-@{
-  char temp[large];
-
-  libg77_catenate (temp, 'prefix', a);
-
-  switch (i (temp))
-    @{
-    case 0:
-      @dots{}
-    @}
-@}
-@end smallexample
-
-And that would leave temp[large] in scope during the CASE blocks
-(although a clever back end *could* see that it isn't referenced
-in them, and thus free that temp before executing the blocks).
-
-So this approach is used instead:
-
-@smallexample
-@{
-  int temp0;
-
-  @{
-    char temp1[large];
-
-    libg77_catenate (temp1, 'prefix', a);
-    temp0 = i (temp1);
-  @}
-
-  switch (temp0)
-    @{
-    case 0:
-      @dots{}
-    @}
-@}
-@end smallexample
-
-Note how @samp{temp1} goes out of scope before starting the switch,
-thus making it easy for a back end to free it.
-
-The problem @emph{that} solution has, however,
-is with @samp{SELECT CASE('prefix'//A)}
-(which is currently not supported).
-
-Unless the GBEL is extended to support arbitrarily long character strings
-in its @code{case} facility,
-the FFE has to implement @code{SELECT CASE} on @code{CHARACTER}
-(probably excepting @code{CHARACTER*1})
-using a cascade of
-@code{if}, @code{elseif}, @code{else}, and @code{endif} constructs
-in GBEL.
-
-To prevent the (potentially large) temporary,
-needed to hold the selected expression itself (@samp{'prefix'//A}),
-from being in scope during execution of the @code{CASE} blocks,
-two approaches are available:
-
-@itemize @bullet
-@item
-Pre-evaluate all the @code{CASE} tests,
-producing an integer ordinal that is used,
-a la @samp{temp0} in the earlier example,
-as if @samp{SELECT CASE(temp0)} had been written.
-
-Each corresponding @code{CASE} is replaced with @samp{CASE(@var{i})},
-where @var{i} is the ordinal for that case,
-determined while, or before,
-generating the cascade of @code{if}-related constructs
-to cope with @code{CHARACTER} selection.
-
-@item
-Make @samp{temp0} above just
-large enough to hold the longest @code{CASE} string
-that'll actually be compared against the expression
-(in this case, @samp{'prefix'//A}).
-
-Since that length must be constant
-(because @code{CASE} expressions are all constant),
-it won't be so large,
-and, further, @samp{temp1} need not be dynamically allocated,
-since normal @code{CHARACTER} assignment can be used
-into the fixed-length @samp{temp0}.
-@end itemize
-
-Both of these solutions require @code{SELECT CASE} implementation
-to be changed so all the corresponding @code{CASE} statements
-are seen during the actual code generation for @code{SELECT CASE}.
-
-@node Transforming Expressions
-@section Transforming Expressions
-
-The interactions between statements, expressions, and subexpressions
-at program run time can be viewed as:
-
-@smallexample
-@var{action}(@var{expr})
-@end smallexample
-
-Here, @var{action} is the series of steps
-performed to effect the statement,
-and @var{expr} is the expression
-whose value is used by @var{action}.
-
-Expanding the above shows a typical order of events at run time:
-
-@smallexample
-Evaluate @var{expr}
-Perform @var{action}, using result of evaluation of @var{expr}
-Clean up after evaluating @var{expr}
-@end smallexample
-
-So, if evaluating @var{expr} requires allocating memory,
-that memory can be freed before performing @var{action}
-only if it is not needed to hold the result of evaluating @var{expr}.
-Otherwise, it must be freed no sooner than
-after @var{action} has been performed.
-
-The above are recursive definitions,
-in the sense that they apply to subexpressions of @var{expr}.
-
-That is, evaluating @var{expr} involves
-evaluating all of its subexpressions,
-performing the @var{action} that computes the
-result value of @var{expr},
-then cleaning up after evaluating those subexpressions.
-
-The recursive nature of this evaluation is implemented
-via recursive-descent transformation of the top-level statements,
-their expressions, @emph{their} subexpressions, and so on.
-
-However, that recursive-descent transformation is,
-due to the nature of the GBEL,
-focused primarily on generating a @emph{single} stream of code
-to be executed at run time.
-
-Yet, from the above, it's clear that multiple streams of code
-must effectively be simultaneously generated
-during the recursive-descent analysis of statements.
-
-The primary stream implements the primary @var{action} items,
-while at least two other streams implement
-the evaluation and clean-up items.
-
-Requirements imposed by expressions include:
-
-@itemize @bullet
-@item
-Whether the caller needs to have a temporary ready
-to hold the value of the expression.
-
-@item
-Other stuff???
-@end itemize
-
-@node Internal Naming Conventions
-@section Internal Naming Conventions
-
-Names exported by FFE modules have the following (regular-expression) forms.
-Note that all names beginning @code{ffe@var{mod}} or @code{FFE@var{mod}},
-where @var{mod} is lowercase or uppercase alphanumerics, respectively,
-are exported by the module @code{ffe@var{mod}},
-with the source code doing the exporting in @file{@var{mod}.h}.
-(Usually, the source code for the implementation is in @file{@var{mod}.c}.)
-
-Identifiers that don't fit the following forms
-are not considered exported,
-even if they are according to the C language.
-(For example, they might be made available to other modules
-solely for use within expansions of exported macros,
-not for use within any source code in those other modules.)
-
-@table @code
-@item ffe@var{mod}
-The single typedef exported by the module.
-
-@item FFE@var{umod}_[A-Z][A-Z0-9_]*
-(Where @var{umod} is the uppercase for of @var{mod}.)
-
-A @code{#define} or @code{enum} constant of the type @code{ffe@var{mod}}.
-
-@item ffe@var{mod}[A-Z][A-Z][a-z0-9]*
-A typedef exported by the module.
-
-The portion of the identifier after @code{ffe@var{mod}} is
-referred to as @code{ctype}, a capitalized (mixed-case) form
-of @code{type}.
-
-@item FFE@var{umod}_@var{type}[A-Z][A-Z0-9_]*[A-Z0-9]?
-(Where @var{umod} is the uppercase for of @var{mod}.)
-
-A @code{#define} or @code{enum} constant of the type
-@code{ffe@var{mod}@var{type}},
-where @var{type} is the lowercase form of @var{ctype}
-in an exported typedef.
-
-@item ffe@var{mod}_@var{value}
-A function that does or returns something,
-as described by @var{value} (see below).
-
-@item ffe@var{mod}_@var{value}_@var{input}
-A function that does or returns something based
-primarily on the thing described by @var{input} (see below).
-@end table
-
-Below are names used for @var{value} and @var{input},
-along with their definitions.
-
-@table @code
-@item col
-A column number within a line (first column is number 1).
-
-@item file
-An encapsulation of a file's name.
-
-@item find
-Looks up an instance of some type that matches specified criteria,
-and returns that, even if it has to create a new instance or
-crash trying to find it (as appropriate).
-
-@item initialize
-Initializes, usually a module.  No type.
-
-@item int
-A generic integer of type @code{int}.
-
-@item is
-A generic integer that contains a true (nonzero) or false (zero) value.
-
-@item len
-A generic integer that contains the length of something.
-
-@item line
-A line number within a source file,
-or a global line number.
-
-@item lookup
-Looks up an instance of some type that matches specified criteria,
-and returns that, or returns nil.
-
-@item name
-A @code{text} that points to a name of something.
-
-@item new
-Makes a new instance of the indicated type.
-Might return an existing one if appropriate---if so,
-similar to @code{find} without crashing.
-
-@item pt
-Pointer to a particular character (line, column pairs)
-in the input file (source code being compiled).
-
-@item run
-Performs some herculean task.  No type.
-
-@item terminate
-Terminates, usually a module.  No type.
-
-@item text
-A @code{char *} that points to generic text.
-@end table
diff --git a/gcc/f/fini.c b/gcc/f/fini.c
deleted file mode 100644
index 167837b..0000000
--- a/gcc/f/fini.c
+++ /dev/null
@@ -1,772 +0,0 @@
-/* fini.c
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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_BCONFIG
-
-#include "proj.h"
-#include "malloc.h"
-
-#undef MAXNAMELEN
-#define MAXNAMELEN 100
-
-typedef struct _name_ *name;
-
-struct _name_
-  {
-    name next;
-    name previous;
-    name next_alpha;
-    name previous_alpha;
-    int namelen;
-    int kwlen;
-    char kwname[MAXNAMELEN];
-    char name_uc[MAXNAMELEN];
-    char name_lc[MAXNAMELEN];
-    char name_ic[MAXNAMELEN];
-  };
-
-struct _name_root_
-  {
-    name first;
-    name last;
-  };
-
-struct _name_alpha_
-  {
-    name ign1;
-    name ign2;
-    name first;
-    name last;
-  };
-
-static FILE *in;
-static FILE *out;
-static char prefix[32];
-static char postfix[32];
-static char storage[32];
-static const char *const xspaces[]
-=
-{
-  "",				/* 0 */
-  " ",				/* 1 */
-  "  ",				/* 2 */
-  "   ",			/* 3 */
-  "    ",			/* 4 */
-  "     ",			/* 5 */
-  "      ",			/* 6 */
-  "       ",			/* 7 */
-  "\t",				/* 8 */
-  "\t ",			/* 9 */
-  "\t  ",			/* 10 */
-  "\t   ",			/* 11 */
-  "\t    ",			/* 12 */
-  "\t     ",			/* 13 */
-  "\t      ",			/* 14 */
-  "\t       ",			/* 15 */
-  "\t\t",			/* 16 */
-  "\t\t ",			/* 17 */
-  "\t\t  ",			/* 18 */
-  "\t\t   ",			/* 19 */
-  "\t\t    ",			/* 20 */
-  "\t\t     ",			/* 21 */
-  "\t\t      ",			/* 22 */
-  "\t\t       ",		/* 23 */
-  "\t\t\t",			/* 24 */
-  "\t\t\t ",			/* 25 */
-  "\t\t\t  ",			/* 26 */
-  "\t\t\t   ",			/* 27 */
-  "\t\t\t    ",			/* 28 */
-  "\t\t\t     ",		/* 29 */
-  "\t\t\t      ",		/* 30 */
-  "\t\t\t       ",		/* 31 */
-  "\t\t\t\t",			/* 32 */
-  "\t\t\t\t ",			/* 33 */
-  "\t\t\t\t  ",			/* 34 */
-  "\t\t\t\t   ",		/* 35 */
-  "\t\t\t\t    ",		/* 36 */
-  "\t\t\t\t     ",		/* 37 */
-  "\t\t\t\t      ",		/* 38 */
-  "\t\t\t\t       ",		/* 39 */
-  "\t\t\t\t\t",			/* 40 */
-  "\t\t\t\t\t ",		/* 41 */
-  "\t\t\t\t\t  ",		/* 42 */
-  "\t\t\t\t\t   ",		/* 43 */
-  "\t\t\t\t\t    ",		/* 44 */
-  "\t\t\t\t\t     ",		/* 45 */
-  "\t\t\t\t\t      ",		/* 46 */
-  "\t\t\t\t\t       ",		/* 47 */
-  "\t\t\t\t\t\t",		/* 48 */
-  "\t\t\t\t\t\t ",		/* 49 */
-  "\t\t\t\t\t\t  ",		/* 50 */
-  "\t\t\t\t\t\t   ",		/* 51 */
-  "\t\t\t\t\t\t    ",		/* 52 */
-  "\t\t\t\t\t\t     ",		/* 53 */
-  "\t\t\t\t\t\t      ",		/* 54 */
-  "\t\t\t\t\t\t       ",	/* 55 */
-  "\t\t\t\t\t\t\t",		/* 56 */
-  "\t\t\t\t\t\t\t ",		/* 57 */
-  "\t\t\t\t\t\t\t  ",		/* 58 */
-  "\t\t\t\t\t\t\t   ",		/* 59 */
-  "\t\t\t\t\t\t\t    ",		/* 60 */
-  "\t\t\t\t\t\t\t     ",	/* 61 */
-  "\t\t\t\t\t\t\t      ",	/* 62 */
-  "\t\t\t\t\t\t\t       ",	/* 63 */
-  "\t\t\t\t\t\t\t\t",		/* 64 */
-  "\t\t\t\t\t\t\t\t ",		/* 65 */
-  "\t\t\t\t\t\t\t\t  ",		/* 66 */
-  "\t\t\t\t\t\t\t\t   ",	/* 67 */
-  "\t\t\t\t\t\t\t\t    ",	/* 68 */
-  "\t\t\t\t\t\t\t\t     ",	/* 69 */
-  "\t\t\t\t\t\t\t\t      ",	/* 70 */
-  "\t\t\t\t\t\t\t\t       ",	/* 71 */
-  "\t\t\t\t\t\t\t\t\t",		/* 72 */
-  "\t\t\t\t\t\t\t\t\t ",	/* 73 */
-  "\t\t\t\t\t\t\t\t\t  ",	/* 74 */
-  "\t\t\t\t\t\t\t\t\t   ",	/* 75 */
-  "\t\t\t\t\t\t\t\t\t    ",	/* 76 */
-  "\t\t\t\t\t\t\t\t\t     ",	/* 77 */
-  "\t\t\t\t\t\t\t\t\t      ",	/* 78 */
-  "\t\t\t\t\t\t\t\t\t       ",	/* 79 */
-  "\t\t\t\t\t\t\t\t\t\t",	/* 80 */
-  "\t\t\t\t\t\t\t\t\t\t ",	/* 81 */
-  "\t\t\t\t\t\t\t\t\t\t  ",	/* 82 */
-  "\t\t\t\t\t\t\t\t\t\t   ",	/* 83 */
-  "\t\t\t\t\t\t\t\t\t\t    ",	/* 84 */
-  "\t\t\t\t\t\t\t\t\t\t     ",	/* 85 */
-  "\t\t\t\t\t\t\t\t\t\t      ",	/* 86 */
-  "\t\t\t\t\t\t\t\t\t\t       ",/* 87 */
-  "\t\t\t\t\t\t\t\t\t\t\t",	/* 88 */
-  "\t\t\t\t\t\t\t\t\t\t\t ",	/* 89 */
-  "\t\t\t\t\t\t\t\t\t\t\t  ",	/* 90 */
-  "\t\t\t\t\t\t\t\t\t\t\t   ",	/* 91 */
-  "\t\t\t\t\t\t\t\t\t\t\t    ",	/* 92 */
-  "\t\t\t\t\t\t\t\t\t\t\t     ",/* 93 */
-  "\t\t\t\t\t\t\t\t\t\t\t      ",	/* 94 */
-  "\t\t\t\t\t\t\t\t\t\t\t       ",	/* 95 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t",	/* 96 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 97 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 98 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t   ",/* 99 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 100 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 101 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 102 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 103 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 104 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t ",/* 105 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 106 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 107 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 108 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 109 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 110 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 111 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 112 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 113 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 114 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 115 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 116 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 117 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 118 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 119 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 120 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 121 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 122 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 123 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 124 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 125 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 126 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 127 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 128 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 129 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 130 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 131 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 132 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 133 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 134 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 135 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 136 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 137 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 138 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 139 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 140 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 141 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 142 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 143 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 144 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 145 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 146 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 147 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 148 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 149 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 150 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 151 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t",	/* 152 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t ",	/* 153 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t  ",	/* 154 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t   ",	/* 155 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t    ",	/* 156 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t     ",	/* 157 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t      ",	/* 158 */
-  "\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t\t       ",	/* 159 */
-};
-
-void testname (bool nested, int indent, name first, name last);
-void testnames (bool nested, int indent, int len, name first, name last);
-
-int
-main (int argc, char **argv)
-{
-  char buf[MAXNAMELEN];
-  char last_buf[MAXNAMELEN];
-  char kwname[MAXNAMELEN];
-  char routine[32];
-  char type[32];
-  int i;
-  int count;
-  int len;
-  struct _name_root_ names[200];
-  struct _name_alpha_ names_alpha;
-  name n;
-  name newname;
-  char *input_name;
-  char *output_name;
-  char *include_name;
-  FILE *incl;
-  int fixlengths;
-  int total_length;
-  int do_name;			/* TRUE if token may be NAME. */
-  int do_names;			/* TRUE if token may be NAMES. */
-  int cc;
-  bool do_exit = FALSE;
-
-  last_buf[0] = '\0';
-  
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
-    {				/* Initialize length/name ordered list roots. */
-      names[i].first = (name) &names[i];
-      names[i].last = (name) &names[i];
-    }
-  names_alpha.first = (name) &names_alpha;	/* Initialize name order. */
-  names_alpha.last = (name) &names_alpha;
-
-  if (argc != 4)
-    {
-      fprintf (stderr, "Command form: fini input output-code output-include\n");
-      return (1);
-    }
-
-  input_name = argv[1];
-  output_name = argv[2];
-  include_name = argv[3];
-
-  in = fopen (input_name, "r");
-  if (in == NULL)
-    {
-      fprintf (stderr, "Cannot open \"%s\"\n", input_name);
-      return (1);
-    }
-  out = fopen (output_name, "w");
-  if (out == NULL)
-    {
-      fclose (in);
-      fprintf (stderr, "Cannot open \"%s\"\n", output_name);
-      return (1);
-    }
-  incl = fopen (include_name, "w");
-  if (incl == NULL)
-    {
-      fclose (in);
-      fprintf (stderr, "Cannot open \"%s\"\n", include_name);
-      return (1);
-    }
-
-  /* Get past the initial block-style comment (man, this parsing code is just
-     _so_ lame, but I'm too lazy to improve it).  */
-
-  for (;;)
-    {
-      cc = getc (in);
-      if (cc == '{')
-	{
-	  while (((cc = getc (in)) != '}') && (cc != EOF))
-	    ;
-	}
-      else if (cc != EOF)
-	{
-	  while (((cc = getc (in)) != EOF) && (! ISALNUM (cc)))
-	    ;
-	  ungetc (cc, in);
-	  break;
-	}
-      else
-	{
-	  assert ("EOF too soon!" == NULL);
-	  return (1);
-	}
-    }
-
-  fscanf (in, "%s %s %s %s %s %d %d", prefix, postfix, storage, type, routine,
-	  &do_name, &do_names);
-
-  if (storage[0] == '\0')
-    storage[1] = '\0';
-  else
-    /* Assume string is quoted somehow, replace ending quote with space. */
-    {
-      if (storage[2] == '\0')
-	storage[1] = '\0';
-      else
-	storage[strlen (storage) - 1] = ' ';
-    }
-
-  if (postfix[0] == '\0')
-    postfix[1] = '\0';
-  else				/* Assume string is quoted somehow, strip off
-				   ending quote. */
-    postfix[strlen (postfix) - 1] = '\0';
-
-  for (i = 1; storage[i] != '\0'; ++i)
-    storage[i - 1] = storage[i];
-  storage[i - 1] = '\0';
-
-  for (i = 1; postfix[i] != '\0'; ++i)
-    postfix[i - 1] = postfix[i];
-  postfix[i - 1] = '\0';
-
-  fixlengths = strlen (prefix) + strlen (postfix);
-
-  while (TRUE)
-    {
-      count = fscanf (in, "%s %s", buf, kwname);
-      if (count == EOF)
-	break;
-      len = strlen (buf);
-      if (len == 0)
-	continue;		/* Skip empty lines. */
-      if (buf[0] == ';')
-	continue;		/* Skip commented-out lines. */
-      for (i = strlen (buf) - 1; i > 0; --i)
-	cc = buf[i];
-
-      /* Make new name object to store name and its keyword. */
-
-      newname = xmalloc (sizeof (*newname));
-      newname->namelen = strlen (buf);
-      newname->kwlen = strlen (kwname);
-      total_length = newname->kwlen + fixlengths;
-      if (total_length >= 32)	/* Else resulting keyword name too long. */
-	{
-	  fprintf (stderr, "%s: %s%s%s is 31+%d chars long\n", input_name,
-		   prefix, kwname, postfix, total_length - 31);
-	  do_exit = TRUE;
-	}
-      strcpy (newname->kwname, kwname);
-      for (i = 0; i < newname->namelen; ++i)
-	{
-	  cc = buf[i];
-	  newname->name_uc[i] = TOUPPER (cc);
-	  newname->name_lc[i] = TOLOWER (cc);
-	  newname->name_ic[i] = cc;
-	}
-      newname->name_uc[i] = newname->name_lc[i] = newname->name_ic[i] = '\0';
-
-      /* Warn user if names aren't alphabetically ordered. */
-
-      if ((last_buf[0] != '\0')
-	  && (strcmp (last_buf, newname->name_uc) >= 0))
-	{
-	  fprintf (stderr, "%s: \"%s\" precedes \"%s\"\n", input_name,
-		   last_buf, newname->name_uc);
-	  do_exit = TRUE;
-	}
-      strcpy (last_buf, newname->name_uc);
-
-      /* Append name to end of alpha-sorted list (assumes names entered in
-	 alpha order wrt name, not kwname, even though kwname is output from
-	 this list). */
-
-      n = names_alpha.last;
-      newname->next_alpha = n->next_alpha;
-      newname->previous_alpha = n;
-      n->next_alpha->previous_alpha = newname;
-      n->next_alpha = newname;
-
-      /* Insert name in appropriate length/name ordered list. */
-
-      n = (name) &names[len];
-      while ((n->next != (name) &names[len])
-	     && (strcmp (buf, n->next->name_uc) > 0))
-	n = n->next;
-      if (strcmp (buf, n->next->name_uc) == 0)
-	{
-	  fprintf (stderr, "%s: extraneous \"%s\"\n", input_name, buf);
-	  do_exit = TRUE;
-	}
-      newname->next = n->next;
-      newname->previous = n;
-      n->next->previous = newname;
-      n->next = newname;
-    }
-
-#if 0
-  for (len = 0; len < ARRAY_SIZE (name); ++len)
-    {
-      if (names[len].first == (name) &names[len])
-	continue;
-      printf ("Length %d:\n", len);
-      for (n = names[len].first; n != (name) &names[len]; n = n->next)
-	printf ("    %s %s %s\n", n->name_uc, n->name_lc, n->name_ic);
-    }
-#endif
-
-  if (do_exit)
-    return (1);
-
-  /* First output the #include file. */
-
-  for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
-    {
-      fprintf (incl, "#define %sl%s%s %d\n", prefix, n->kwname, postfix,
-	       n->namelen);
-    }
-
-  fprintf (incl,
-	   "\
-\n\
-enum %s_\n\
-{\n\
-%sNone%s,\n\
-",
-	   type, prefix, postfix);
-
-  for (n = names_alpha.first; n != (name) &names_alpha; n = n->next_alpha)
-    {
-      fprintf (incl,
-	       "\
-%s%s%s,\n\
-",
-	       prefix, n->kwname, postfix);
-    }
-
-  fprintf (incl,
-	   "\
-%s%s\n\
-};\n\
-typedef enum %s_ %s;\n\
-",
-	   prefix, postfix, type, type);
-
-  /* Now output the C program. */
-
-  fprintf (out,
-	   "\
-%s%s\n\
-%s (ffelexToken t)\n\
-%c\n\
-  char *p;\n\
-  int c;\n\
-\n\
-  p = ffelex_token_text (t);\n\
-\n\
-",
-	   storage, type, routine, '{');
-
-  if (do_name)
-    {
-      if (do_names)
-	fprintf (out,
-		 "\
-  if (ffelex_token_type (t) == FFELEX_typeNAME)\n\
-    {\n\
-      switch (ffelex_token_length (t))\n\
-\t{\n\
-"
-	  );
-      else
-	fprintf (out,
-		 "\
-  assert (ffelex_token_type (t) == FFELEX_typeNAME);\n\
-\n\
-  switch (ffelex_token_length (t))\n\
-    {\n\
-"
-	  );
-
-/* Now output the length as a case, followed by the binary search within that length.  */
-
-      for (len = 0; ((size_t) len) < ARRAY_SIZE (names); ++len)
-	{
-	  if (names[len].first != (name) &names[len])
-	    {
-	      if (do_names)
-		fprintf (out,
-			 "\
-\tcase %d:\n\
-",
-			 len);
-	      else
-		fprintf (out,
-			 "\
-    case %d:\n\
-",
-			 len);
-	      testname (FALSE, do_names ? 10 : 6, names[len].first, names[len].last);
-	      if (do_names)
-		fprintf (out,
-			 "\
-\t  break;\n\
-"
-		  );
-	      else
-		fprintf (out,
-			 "\
-      break;\n\
-"
-		  );
-	    }
-	}
-
-      if (do_names)
-	fprintf (out,
-		 "\
-\t}\n\
-      return %sNone%s;\n\
-    }\n\
-\n\
-",
-		 prefix, postfix);
-      else
-	fprintf (out,
-		 "\
-    }\n\
-\n\
-  return %sNone%s;\n\
-}\n\
-",
-		 prefix, postfix);
-    }
-
-  if (do_names)
-    {
-      fputs ("\
-  assert (ffelex_token_type (t) == FFELEX_typeNAMES);\n\
-\n\
-  switch (ffelex_token_length (t))\n\
-    {\n\
-    default:\n\
-",
-	     out);
-
-      /* Find greatest non-empty length list. */
-
-      for (len = ARRAY_SIZE (names) - 1;
-	   names[len].first == (name) &names[len];
-	   --len)
-	;
-
-/* Now output the length as a case, followed by the binary search within that length. */
-
-      if (len > 0)
-	{
-	  for (; len != 0; --len)
-	    {
-	      fprintf (out,
-		       "\
-    case %d:\n\
-",
-		       len);
-	      if (names[len].first != (name) &names[len])
-		testnames (FALSE, 6, len, names[len].first, names[len].last);
-	    }
-	  if (names[1].first == (name) &names[1])
-	    fprintf (out,
-		     "\
-      ;\n\
-"
-	      );		/* Need empty statement after an empty case
-				   1:  */
-	}
-
-      fprintf (out,
-	       "\
-    }\n\
-\n\
-  return %sNone%s;\n\
-}\n\
-",
-	       prefix, postfix);
-    }
-
-  if (out != stdout)
-    fclose (out);
-  if (incl != stdout)
-    fclose (incl);
-  if (in != stdin)
-    fclose (in);
-  return (0);
-}
-
-void
-testname (bool nested, int indent, name first, name last)
-{
-  name n;
-  name nhalf;
-  int num;
-  int numhalf;
-
-  assert (!nested || indent >= 2);
-  assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces));
-
-  num = 0;
-  numhalf = 0;
-  for (n = first, nhalf = first; n != last->next; n = n->next)
-    {
-      if ((++num & 1) == 0)
-	{
-	  nhalf = nhalf->next;
-	  ++numhalf;
-	}
-    }
-
-  if (nested)
-    fprintf (out,
-	     "\
-%s{\n\
-",
-	     xspaces[indent - 2]);
-
-  fprintf (out,
-	   "\
-%sif ((c = ffesrc_strcmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\")) == 0)\n\
-%sreturn %s%s%s;\n\
-",
-	   xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
-	   xspaces[indent + 2], prefix, nhalf->kwname, postfix);
-
-  if (num != 1)
-    {
-      fprintf (out,
-	       "\
-%selse if (c < 0)\n\
-",
-	       xspaces[indent]);
-
-      if (numhalf == 0)
-	fprintf (out,
-		 "\
-%s;\n\
-",
-		 xspaces[indent + 2]);
-      else
-	testname (TRUE, indent + 4, first, nhalf->previous);
-
-      if (num - numhalf > 1)
-	{
-	  fprintf (out,
-		   "\
-%selse\n\
-",
-		   xspaces[indent]);
-
-	  testname (TRUE, indent + 4, nhalf->next, last);
-	}
-    }
-
-  if (nested)
-    fprintf (out,
-	     "\
-%s}\n\
-",
-	     xspaces[indent - 2]);
-}
-
-void
-testnames (bool nested, int indent, int len, name first, name last)
-{
-  name n;
-  name nhalf;
-  int num;
-  int numhalf;
-
-  assert (!nested || indent >= 2);
-  assert (((size_t) indent) + 4 < ARRAY_SIZE (xspaces));
-
-  num = 0;
-  numhalf = 0;
-  for (n = first, nhalf = first; n != last->next; n = n->next)
-    {
-      if ((++num & 1) == 0)
-	{
-	  nhalf = nhalf->next;
-	  ++numhalf;
-	}
-    }
-
-  if (nested)
-    fprintf (out,
-	     "\
-%s{\n\
-",
-	     xspaces[indent - 2]);
-
-  fprintf (out,
-	   "\
-%sif ((c = ffesrc_strncmp_2c (ffe_case_match (), p, \"%s\", \"%s\", \"%s\", %d)) == 0)\n\
-%sreturn %s%s%s;\n\
-",
-	   xspaces[indent], nhalf->name_uc, nhalf->name_lc, nhalf->name_ic,
-	   len, xspaces[indent + 2], prefix, nhalf->kwname, postfix);
-
-  if (num != 1)
-    {
-      fprintf (out,
-	       "\
-%selse if (c < 0)\n\
-",
-	       xspaces[indent]);
-
-      if (numhalf == 0)
-	fprintf (out,
-		 "\
-%s;\n\
-",
-		 xspaces[indent + 2]);
-      else
-	testnames (TRUE, indent + 4, len, first, nhalf->previous);
-
-      if (num - numhalf > 1)
-	{
-	  fprintf (out,
-		   "\
-%selse\n\
-",
-		   xspaces[indent]);
-
-	  testnames (TRUE, indent + 4, len, nhalf->next, last);
-	}
-    }
-
-  if (nested)
-    fprintf (out,
-	     "\
-%s}\n\
-",
-	     xspaces[indent - 2]);
-}
diff --git a/gcc/f/g77.texi b/gcc/f/g77.texi
deleted file mode 100644
index d97f69c..0000000
--- a/gcc/f/g77.texi
+++ /dev/null
@@ -1,11848 +0,0 @@
-\input texinfo  @c -*-texinfo-*-
-@c %**start of header
-@setfilename g77.info
-
-@set last-update 2004-03-21
-@set copyrights-g77 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004
-
-@include root.texi
-
-@c This tells @include'd files that they're part of the overall G77 doc
-@c set.  (They might be part of a higher-level doc set too.)
-@set DOC-G77
-
-@c @setfilename useg77.info
-@c @setfilename portg77.info
-@c To produce the full manual, use the "g77.info" setfilename, and
-@c make sure the following do NOT begin with '@c' (and the @clear lines DO)
-@set INTERNALS
-@set USING
-@c To produce a user-only manual, use the "useg77.info" setfilename, and
-@c make sure the following does NOT begin with '@c':
-@c @clear INTERNALS
-@c To produce a porter-only manual, use the "portg77.info" setfilename,
-@c and make sure the following does NOT begin with '@c':
-@c @clear USING
-
-@ifset INTERNALS
-@ifset USING
-@settitle Using and Porting GNU Fortran
-@end ifset
-@end ifset
-@c seems reasonable to assume at least one of INTERNALS or USING is set...
-@ifclear INTERNALS
-@settitle Using GNU Fortran
-@end ifclear
-@ifclear USING
-@settitle Porting GNU Fortran
-@end ifclear
-@c then again, have some fun
-@ifclear INTERNALS
-@ifclear USING
-@settitle Doing Squat with GNU Fortran
-@end ifclear
-@end ifclear
-
-@syncodeindex fn cp
-@syncodeindex vr cp
-@c %**end of header
-
-@c Cause even numbered pages to be printed on the left hand side of
-@c the page and odd numbered pages to be printed on the right hand
-@c side of the page.  Using this, you can print on both sides of a
-@c sheet of paper and have the text on the same part of the sheet.
-
-@c The text on right hand pages is pushed towards the right hand
-@c margin and the text on left hand pages is pushed toward the left
-@c hand margin.
-@c (To provide the reverse effect, set bindingoffset to -0.75in.)
-
-@c @tex
-@c \global\bindingoffset=0.75in
-@c \global\normaloffset =0.75in
-@c @end tex
-
-@copying
-Copyright @copyright{} @value{copyrights-g77} Free Software Foundation, Inc.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'' and ``Funding
-Free Software'', the Front-Cover
-texts being (a) (see below), and with the Back-Cover Texts being (b)
-(see below).  A copy of the license is included in the section entitled
-``GNU Free Documentation License''.
-
-(a) The FSF's Front-Cover Text is:
-
-     A GNU Manual
-
-(b) The FSF's Back-Cover Text is:
-
-     You have freedom to copy and modify this GNU Manual, like GNU
-     software.  Copies published by the Free Software Foundation raise
-     funds for GNU development.
-@end copying
-
-@ifinfo
-@dircategory Programming
-@direntry
-* g77: (g77).                  The GNU Fortran compiler.
-@end direntry
-@ifset INTERNALS
-@ifset USING
-This file documents the use and the internals of the GNU Fortran (@command{g77})
-compiler.
-It corresponds to the @value{which-g77} version of @command{g77}.
-@end ifset
-@end ifset
-@ifclear USING
-This file documents the internals of the GNU Fortran (@command{g77}) compiler.
-It corresponds to the @value{which-g77} version of @command{g77}.
-@end ifclear
-@ifclear INTERNALS
-This file documents the use of the GNU Fortran (@command{g77}) compiler.
-It corresponds to the @value{which-g77} version of @command{g77}.
-@end ifclear
-
-Published by the Free Software Foundation
-59 Temple Place - Suite 330
-Boston, MA 02111-1307 USA
-
-@insertcopying
-@end ifinfo
-
-Contributed by James Craig Burley (@email{@value{email-burley}}).
-Inspired by a first pass at translating @file{g77-0.5.16/f/DOC} that
-was contributed to Craig by David Ronis (@email{ronis@@onsager.chem.mcgill.ca}).
-
-@setchapternewpage odd
-@titlepage
-@ifset INTERNALS
-@ifset USING
-@center @titlefont{Using and Porting GNU Fortran}
-
-@end ifset
-@end ifset
-@ifclear INTERNALS
-@title Using GNU Fortran
-@end ifclear
-@ifclear USING
-@title Porting GNU Fortran
-@end ifclear
-@sp 2
-@center James Craig Burley
-@sp 3
-@center Last updated @value{last-update}
-@sp 1
-@center for version @value{which-g77}
-@page
-@vskip 0pt plus 1filll
-For the @value{which-g77} Version*
-@sp 1
-Published by the Free Software Foundation @*
-59 Temple Place - Suite 330@*
-Boston, MA 02111-1307, USA@*
-@c Last printed ??ber, 19??.@*
-@c Printed copies are available for $? each.@*
-@c ISBN ???
-@sp 1
-@insertcopying
-@end titlepage
-@summarycontents
-@contents
-@page
-
-@node Top, Copying,, (DIR)
-@top Introduction
-@cindex Introduction
-
-@ifset INTERNALS
-@ifset USING
-This manual documents how to run, install and port @command{g77},
-as well as its new features and incompatibilities,
-and how to report bugs.
-It corresponds to the @value{which-g77} version of @command{g77}.
-@end ifset
-@end ifset
-
-@ifclear INTERNALS
-This manual documents how to run and install @command{g77},
-as well as its new features and incompatibilities, and how to report
-bugs.
-It corresponds to the @value{which-g77} version of @command{g77}.
-@end ifclear
-@ifclear USING
-This manual documents how to port @command{g77},
-as well as its new features and incompatibilities,
-and how to report bugs.
-It corresponds to the @value{which-g77} version of @command{g77}.
-@end ifclear
-
-@ifset DEVELOPMENT
-@emph{Warning:} This document is still under development,
-and might not accurately reflect the @command{g77} code base
-of which it is a part.
-Efforts are made to keep it somewhat up-to-date,
-but they are particularly concentrated
-on any version of this information
-that is distributed as part of a @emph{released} @command{g77}.
-
-In particular, while this document is intended to apply to
-the @value{which-g77} version of @command{g77},
-only an official @emph{release} of that version
-is expected to contain documentation that is
-most consistent with the @command{g77} product in that version.
-@end ifset
-
-@menu
-* Copying::         GNU General Public License says
-                    how you can copy and share GNU Fortran.
-* GNU Free Documentation License::
-		    How you can copy and share this manual.
-* Contributors::    People who have contributed to GNU Fortran.
-* Funding::         How to help assure continued work for free software.
-* Funding GNU Fortran::  How to help assure continued work on GNU Fortran.
-@ifset USING
-* Getting Started:: Finding your way around this manual.
-* What is GNU Fortran?::  How @command{g77} fits into the universe.
-* G77 and GCC::     You can compile Fortran, C, or other programs.
-* Invoking G77::    Command options supported by @command{g77}.
-* News::            News about recent releases of @command{g77}.
-* Changes::         User-visible changes to recent releases of @command{g77}.
-* Language::        The GNU Fortran language.
-* Compiler::        The GNU Fortran compiler.
-* Other Dialects::  Dialects of Fortran supported by @command{g77}.
-* Other Compilers:: Fortran compilers other than @command{g77}.
-* Other Languages:: Languages other than Fortran.
-* Debugging and Interfacing::  How @command{g77} generates code.
-* Collected Fortran Wisdom::  How to avoid Trouble.
-* Trouble::         If you have trouble with GNU Fortran.
-* Open Questions::  Things we'd like to know.
-* Bugs::            How, why, and where to report bugs.
-* Service::         How to find suppliers of support for GNU Fortran.
-@end ifset
-@ifset INTERNALS
-* Adding Options::  Guidance on teaching @command{g77} about new options.
-* Projects::        Projects for @command{g77} internals hackers.
-* Front End::       Design and implementation of the @command{g77} front end.
-@end ifset
-
-* M: Diagnostics.   Diagnostics produced by @command{g77}.
-
-* Keyword Index::   Index of concepts and symbol names.
-@end menu
-@c yes, the "M: " @emph{is} intentional -- bad.def references it (CMPAMBIG)!
-
-@include gpl.texi
-
-@include fdl.texi
-
-@node Contributors
-@unnumbered Contributors to GNU Fortran
-@cindex contributors
-@cindex credits
-
-In addition to James Craig Burley, who wrote the front end,
-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 GCC compiler.
-@xref{Contributors,,Contributors to GCC,gcc,Using the GNU Compiler
-Collection (GCC)},
-for more information.
-
-@item
-The run-time library used by GNU Fortran is a repackaged version
-of the @code{libf2c} library (combined from the @code{libF77} and
-@code{libI77} libraries) provided as part of @command{f2c}, available for
-free from @code{netlib} sites on the Internet.
-
-@item
-Cygnus Support and The Free Software Foundation contributed
-significant money and/or equipment to Craig's efforts.
-
-@item
-The following individuals served as alpha testers prior to @command{g77}'s
-public release.  This work consisted of testing, researching, sometimes
-debugging, and occasionally providing small amounts of code and fixes
-for @command{g77}, plus offering plenty of helpful advice to Craig:
-
-@itemize @w{}
-@item
-Jonathan Corbet
-@item
-Dr.@: Mark Fernyhough
-@item
-Takafumi Hayashi (The University of Aizu)---@email{takafumi@@u-aizu.ac.jp}
-@item
-Kate Hedstrom
-@item
-Michel Kern (INRIA and Rice University)---@email{Michel.Kern@@inria.fr}
-@item
-Dr.@: A. O. V. Le Blanc
-@item
-Dave Love
-@item
-Rick Lutowski
-@item
-Toon Moene
-@item
-Rick Niles
-@item
-Derk Reefman
-@item
-Wayne K. Schroll
-@item
-Bill Thorson
-@item
-Pedro A. M. Vazquez
-@item
-Ian Watson
-@end itemize
-
-@item
-Dave Love (@email{d.love@@dl.ac.uk})
-wrote the libU77 part of the run-time library.
-
-@item
-Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
-provided the patch to add rudimentary support
-for @code{INTEGER*1}, @code{INTEGER*2}, and
-@code{LOGICAL*1}.
-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
-and encouraged Craig to rewrite the documentation in texinfo
-format by contributing a first pass at a translation of the
-old @file{g77-0.5.16/f/DOC} file.
-
-@item
-Toon Moene (@email{toon@@moene.indiv.nluug.nl}) performed
-some analysis of generated code as part of an overall project
-to improve @command{g77} code generation to at least be as good
-as @command{f2c} used in conjunction with @command{gcc}.
-So far, this has resulted in the three, somewhat
-experimental, options added by @command{g77} to the @command{gcc}
-compiler and its back end.
-
-(These, in turn, had made their way into the @code{egcs}
-version of the compiler, and do not exist in @command{gcc}
-version 2.8 or versions of @command{g77} based on that version
-of @command{gcc}.)
-
-@item
-John Carr (@email{jfc@@mit.edu}) wrote the alias analysis improvements.
-
-@item
-Thanks to Mary Cortani and the staff at Craftwork Solutions
-(@email{support@@craftwork.com}) for all of their support.
-
-@item
-Many other individuals have helped debug, test, and improve @command{g77}
-over the past several years, and undoubtedly more people
-will be doing so in the future.
-If you have done so, and would like
-to see your name listed in the above list, please ask!
-The default is that people wish to remain anonymous.
-@end itemize
-
-@include funding.texi
-
-@node Funding GNU Fortran
-@chapter Funding GNU Fortran
-@cindex funding improvements
-@cindex improvements, funding
-
-James Craig Burley (@email{@value{email-burley}}), the original author
-of @command{g77}, stopped working on it in September 1999
-(He has a web page at @uref{@value{www-burley}}.)
-
-GNU Fortran is currently maintained by Toon Moene
-(@email{toon@@moene.indiv.nluug.nl}), with the help of countless other
-volunteers.
-
-As with other GNU software, funding is important because it can pay for
-needed equipment, personnel, and so on.
-
-@cindex FSF, funding the
-@cindex funding the FSF
-The FSF provides information on the best way to fund ongoing
-development of GNU software (such as GNU Fortran) in documents
-such as the ``GNUS Bulletin''.
-Email @email{gnu@@gnu.org} for information on funding the FSF.
-
-Another important way to support work on GNU Fortran is to volunteer
-to help out.
-
-Email @email{@value{email-general}} to volunteer for this work.
-
-However, we strongly expect that there will never be a version 0.6
-of @command{g77}.  Work on this compiler has stopped as of the release
-of GCC 3.1, except for bug fixing.  @command{g77} will be succeeded by
-@command{g95} - see @uref{http://g95.sourceforge.net}.
-
-@xref{Funding,,Funding Free Software}, for more information.
-
-@node Getting Started
-@chapter Getting Started
-@cindex getting started
-@cindex new users
-@cindex newbies
-@cindex beginners
-
-If you don't need help getting started reading the portions
-of this manual that are most important to you, you should skip
-this portion of the manual.
-
-If you are new to compilers, especially Fortran compilers, or
-new to how compilers are structured under UNIX and UNIX-like
-systems, you'll want to see @ref{What is GNU Fortran?}.
-
-If you are new to GNU compilers, or have used only one GNU
-compiler in the past and not had to delve into how it lets
-you manage various versions and configurations of @command{gcc},
-you should see @ref{G77 and GCC}.
-
-Everyone except experienced @command{g77} users should
-see @ref{Invoking G77}.
-
-If you're acquainted with previous versions of @command{g77},
-you should see @ref{News,,News About GNU Fortran}.
-Further, if you've actually used previous versions of @command{g77},
-especially if you've written or modified Fortran code to
-be compiled by previous versions of @command{g77}, you
-should see @ref{Changes}.
-
-If you intend to write or otherwise compile code that is
-not already strictly conforming ANSI FORTRAN 77---and this
-is probably everyone---you should see @ref{Language}.
-
-If you run into trouble getting Fortran code to compile,
-link, run, or work properly, you might find answers
-if you see @ref{Debugging and Interfacing},
-see @ref{Collected Fortran Wisdom},
-and see @ref{Trouble}.
-You might also find that the problems you are encountering
-are bugs in @command{g77}---see @ref{Bugs}, for information on
-reporting them, after reading the other material.
-
-If you need further help with @command{g77}, or with
-freely redistributable software in general,
-see @ref{Service}.
-
-If you would like to help the @command{g77} project,
-see @ref{Funding GNU Fortran}, for information on
-helping financially, and see @ref{Projects}, for information
-on helping in other ways.
-
-If you're generally curious about the future of
-@command{g77}, see @ref{Projects}.
-If you're curious about its past,
-see @ref{Contributors},
-and see @ref{Funding GNU Fortran}.
-
-To see a few of the questions maintainers of @command{g77} have,
-and that you might be able to answer,
-see @ref{Open Questions}.
-
-@ifset USING
-@node What is GNU Fortran?
-@chapter What is GNU Fortran?
-@cindex concepts, basic
-@cindex basic concepts
-
-GNU Fortran, or @command{g77}, is designed initially as a free replacement
-for, or alternative to, the UNIX @command{f77} command.
-(Similarly, @command{gcc} is designed as a replacement
-for the UNIX @command{cc} command.)
-
-@command{g77} also is designed to fit in well with the other
-fine GNU compilers and tools.
-
-Sometimes these design goals conflict---in such cases, resolution
-often is made in favor of fitting in well with Project GNU.
-These cases are usually identified in the appropriate
-sections of this manual.
-
-@cindex compilers
-As compilers, @command{g77}, @command{gcc}, and @command{f77}
-share the following characteristics:
-
-@itemize @bullet
-@cindex source code
-@cindex file, source
-@cindex code, source
-@cindex source file
-@item
-They read a user's program, stored in a file and
-containing instructions written in the appropriate
-language (Fortran, C, and so on).
-This file contains @dfn{source code}.
-
-@cindex translation of user programs
-@cindex machine code
-@cindex code, machine
-@cindex mistakes
-@item
-They translate the user's program into instructions
-a computer can carry out more quickly than it takes
-to translate the instructions in the first place.
-These instructions are called @dfn{machine code}---code
-designed to be efficiently translated and processed
-by a machine such as a computer.
-Humans usually aren't as good writing machine code
-as they are at writing Fortran or C, because
-it is easy to make tiny mistakes writing machine code.
-When writing Fortran or C, it is easy
-to make big mistakes.
-
-@cindex debugger
-@cindex bugs, finding
-@cindex @command{gdb}, command
-@cindex commands, @command{gdb}
-@item
-They provide information in the generated machine code
-that can make it easier to find bugs in the program
-(using a debugging tool, called a @dfn{debugger},
-such as @command{gdb}).
-
-@cindex libraries
-@cindex linking
-@cindex @command{ld} command
-@cindex commands, @command{ld}
-@item
-They locate and gather machine code already generated
-to perform actions requested by statements in
-the user's program.
-This machine code is organized
-into @dfn{libraries} and is located and gathered
-during the @dfn{link} phase of the compilation
-process.
-(Linking often is thought of as a separate
-step, because it can be directly invoked via the
-@command{ld} command.
-However, the @command{g77} and @command{gcc}
-commands, as with most compiler commands, automatically
-perform the linking step by calling on @command{ld}
-directly, unless asked to not do so by the user.)
-
-@cindex language, incorrect use of
-@cindex incorrect use of language
-@item
-They attempt to diagnose cases where the user's
-program contains incorrect usages of the language.
-The @dfn{diagnostics} produced by the compiler
-indicate the problem and the location in the user's
-source file where the problem was first noticed.
-The user can use this information to locate and
-fix the problem.
-@cindex diagnostics, incorrect
-@cindex incorrect diagnostics
-@cindex error messages, incorrect
-@cindex incorrect error messages
-(Sometimes an incorrect usage
-of the language leads to a situation where the
-compiler can no longer make any sense of what
-follows---while a human might be able to---and
-thus ends up complaining about many ``problems''
-it encounters that, in fact, stem from just one
-problem, usually the first one reported.)
-
-@cindex warnings
-@cindex questionable instructions
-@item
-They attempt to diagnose cases where the user's
-program contains a correct usage of the language,
-but instructs the computer to do something questionable.
-These diagnostics often are in the form of @dfn{warnings},
-instead of the @dfn{errors} that indicate incorrect
-usage of the language.
-@end itemize
-
-How these actions are performed is generally under the
-control of the user.
-Using command-line options, the user can specify
-how persnickety the compiler is to be regarding
-the program (whether to diagnose questionable usage
-of the language), how much time to spend making
-the generated machine code run faster, and so on.
-
-@cindex components of @command{g77}
-@cindex @command{g77}, components of
-@command{g77} consists of several components:
-
-@cindex @command{gcc}, command
-@cindex commands, @command{gcc}
-@itemize @bullet
-@item
-A modified version of the @command{gcc} command, which also might be
-installed as the system's @command{cc} command.
-(In many cases, @command{cc} refers to the
-system's ``native'' C compiler, which
-might be a non-GNU compiler, or an older version
-of @command{gcc} considered more stable or that is
-used to build the operating system kernel.)
-
-@cindex @command{g77}, command
-@cindex commands, @command{g77}
-@item
-The @command{g77} command itself, which also might be installed as the
-system's @command{f77} command.
-
-@cindex libg2c library
-@cindex libf2c library
-@cindex libraries, libf2c
-@cindex libraries, libg2c
-@cindex run-time, library
-@item
-The @code{libg2c} run-time library.
-This library contains the machine code needed to support
-capabilities of the Fortran language that are not directly
-provided by the machine code generated by the @command{g77}
-compilation phase.
-
-@code{libg2c} is just the unique name @command{g77} gives
-to its version of @code{libf2c} to distinguish it from
-any copy of @code{libf2c} installed from @command{f2c}
-(or versions of @command{g77} that built @code{libf2c} under
-that same name)
-on the system.
-
-The maintainer of @code{libf2c} currently is
-@email{dmg@@bell-labs.com}.
-
-@cindex @code{f771}, program
-@cindex programs, @code{f771}
-@cindex assembler
-@cindex @command{as} command
-@cindex commands, @command{as}
-@cindex assembly code
-@cindex code, assembly
-@item
-The compiler itself, internally named @code{f771}.
-
-Note that @code{f771} does not generate machine code directly---it
-generates @dfn{assembly code} that is a more readable form
-of machine code, leaving the conversion to actual machine code
-to an @dfn{assembler}, usually named @command{as}.
-@end itemize
-
-@command{gcc} is often thought of as ``the C compiler'' only,
-but it does more than that.
-Based on command-line options and the names given for files
-on the command line, @command{gcc} determines which actions to perform, including
-preprocessing, compiling (in a variety of possible languages), assembling,
-and linking.
-
-@cindex driver, gcc command as
-@cindex @command{gcc}, command as driver
-@cindex executable file
-@cindex files, executable
-@cindex cc1 program
-@cindex programs, cc1
-@cindex preprocessor
-@cindex cpp program
-@cindex programs, cpp
-For example, the command @samp{gcc foo.c} @dfn{drives} the file
-@file{foo.c} through the preprocessor @command{cpp}, then
-the C compiler (internally named
-@code{cc1}), then the assembler (usually @command{as}), then the linker
-(@command{ld}), producing an executable program named @file{a.out} (on
-UNIX systems).
-
-@cindex cc1plus program
-@cindex programs, cc1plus
-As another example, the command @samp{gcc foo.cc} would do much the same as
-@samp{gcc foo.c}, but instead of using the C compiler named @code{cc1},
-@command{gcc} would use the C++ compiler (named @code{cc1plus}).
-
-@cindex @code{f771}, program
-@cindex programs, @code{f771}
-In a GNU Fortran installation, @command{gcc} recognizes Fortran source
-files by name just like it does C and C++ source files.
-It knows to use the Fortran compiler named @code{f771}, instead of
-@code{cc1} or @code{cc1plus}, to compile Fortran files.
-
-@cindex @command{gcc}, not recognizing Fortran source
-@cindex unrecognized file format
-@cindex file format not recognized
-Non-Fortran-related operation of @command{gcc} is generally
-unaffected by installing the GNU Fortran version of @command{gcc}.
-However, without the installed version of @command{gcc} being the
-GNU Fortran version, @command{gcc} will not be able to compile
-and link Fortran programs---and since @command{g77} uses @command{gcc}
-to do most of the actual work, neither will @command{g77}!
-
-@cindex @command{g77}, command
-@cindex commands, @command{g77}
-The @command{g77} command is essentially just a front-end for
-the @command{gcc} command.
-Fortran users will normally use @command{g77} instead of @command{gcc},
-because @command{g77}
-knows how to specify the libraries needed to link with Fortran programs
-(@code{libg2c} and @code{lm}).
-@command{g77} can still compile and link programs and
-source files written in other languages, just like @command{gcc}.
-
-@cindex printing version information
-@cindex version information, printing
-The command @samp{g77 -v} is a quick
-way to display lots of version information for the various programs
-used to compile a typical preprocessed Fortran source file---this
-produces much more output than @samp{gcc -v} currently does.
-(If it produces an error message near the end of the output---diagnostics
-from the linker, usually @command{ld}---you might
-have an out-of-date @code{libf2c} that improperly handles
-complex arithmetic.)
-In the output of this command, the line beginning @samp{GNU Fortran Front
-End} identifies the version number of GNU Fortran; immediately
-preceding that line is a line identifying the version of @command{gcc}
-with which that version of @command{g77} was built.
-
-@cindex libf2c library
-@cindex libraries, libf2c
-The @code{libf2c} library is distributed with GNU Fortran for
-the convenience of its users, but is not part of GNU Fortran.
-It contains the procedures
-needed by Fortran programs while they are running.
-
-@cindex in-line code
-@cindex code, in-line
-For example, while code generated by @command{g77} is likely
-to do additions, subtractions, and multiplications @dfn{in line}---in
-the actual compiled code---it is not likely to do trigonometric
-functions this way.
-
-Instead, operations like trigonometric
-functions are compiled by the @code{f771} compiler
-(invoked by @command{g77} when compiling Fortran code) into machine
-code that, when run, calls on functions in @code{libg2c}, so
-@code{libg2c} must be linked with almost every useful program
-having any component compiled by GNU Fortran.
-(As mentioned above, the @command{g77} command takes
-care of all this for you.)
-
-The @code{f771} program represents most of what is unique to GNU Fortran.
-While much of the @code{libg2c} component comes from
-the @code{libf2c} component of @command{f2c},
-a free Fortran-to-C converter distributed by Bellcore (AT&T),
-plus @code{libU77}, provided by Dave Love,
-and the @command{g77} command is just a small front-end to @command{gcc},
-@code{f771} is a combination of two rather
-large chunks of code.
-
-@cindex GNU Back End (GBE)
-@cindex GBE
-@cindex @command{gcc}, back end
-@cindex back end, gcc
-@cindex code generator
-One chunk is the so-called @dfn{GNU Back End}, or GBE,
-which knows how to generate fast code for a wide variety of processors.
-The same GBE is used by the C, C++, and Fortran compiler programs @code{cc1},
-@code{cc1plus}, and @code{f771}, plus others.
-Often the GBE is referred to as the ``gcc back end'' or
-even just ``gcc''---in this manual, the term GBE is used
-whenever the distinction is important.
-
-@cindex GNU Fortran Front End (FFE)
-@cindex FFE
-@cindex @command{g77}, front end
-@cindex front end, @command{g77}
-The other chunk of @code{f771} is the
-majority of what is unique about GNU Fortran---the code that knows how
-to interpret Fortran programs to determine what they are intending to
-do, and then communicate that knowledge to the GBE for actual compilation
-of those programs.
-This chunk is called the @dfn{Fortran Front End} (FFE).
-The @code{cc1} and @code{cc1plus} programs have their own front ends,
-for the C and C++ languages, respectively.
-These fronts ends are responsible for diagnosing
-incorrect usage of their respective languages by the
-programs the process, and are responsible for most of
-the warnings about questionable constructs as well.
-(The GBE handles producing some warnings, like those
-concerning possible references to undefined variables.)
-
-Because so much is shared among the compilers for various languages,
-much of the behavior and many of the user-selectable options for these
-compilers are similar.
-For example, diagnostics (error messages and
-warnings) are similar in appearance; command-line
-options like @option{-Wall} have generally similar effects; and the quality
-of generated code (in terms of speed and size) is roughly similar
-(since that work is done by the shared GBE).
-
-@node G77 and GCC
-@chapter Compile Fortran, C, or Other Programs
-@cindex compiling programs
-@cindex programs, compiling
-
-@cindex @command{gcc}, command
-@cindex commands, @command{gcc}
-A GNU Fortran installation includes a modified version of the @command{gcc}
-command.
-
-In a non-Fortran installation, @command{gcc} recognizes C, C++,
-and Objective-C source files.
-
-In a GNU Fortran installation, @command{gcc} also recognizes Fortran source
-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,,Programming Languages Supported by GCC,gcc,Using
-the GNU Compiler Collection (GCC)},
-for information on the way different languages are handled
-by the GCC compiler (@command{gcc}).
-
-@cindex @command{g77}, command
-@cindex commands, @command{g77}
-Also provided as part of GNU Fortran is the @command{g77} command.
-The @command{g77} command is designed to make compiling and linking Fortran
-programs somewhat easier than when using the @command{gcc} command for
-these tasks.
-It does this by analyzing the command line somewhat and changing it
-appropriately before submitting it to the @command{gcc} command.
-
-@cindex -v option
-@cindex @command{g77} options, -v
-@cindex options, -v
-Use the @option{-v} option with @command{g77}
-to see what is going on---the first line of output is the invocation
-of the @command{gcc} command.
-
-@include invoke.texi
-
-@include news.texi
-
-@set USERVISONLY
-@include news.texi
-@clear USERVISONLY
-
-@node Language
-@chapter The GNU Fortran Language
-
-@cindex standard, ANSI FORTRAN 77
-@cindex ANSI FORTRAN 77 standard
-@cindex reference works
-GNU Fortran supports a variety of extensions to, and dialects
-of, the Fortran language.
-Its primary base is the ANSI FORTRAN 77 standard, currently available on
-the network at
-@uref{http://www.fortran.com/fortran/F77_std/rjcnf0001.html}
-or as monolithic text at
-@uref{http://www.fortran.com/fortran/F77_std/f77_std.html}.
-It offers some extensions that are popular among users
-of UNIX @command{f77} and @command{f2c} compilers, some that
-are popular among users of other compilers (such as Digital
-products), some that are popular among users of the
-newer Fortran 90 standard, and some that are introduced
-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/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}.)
-
-Part of what defines a particular implementation of a Fortran
-system, such as @command{g77}, is the particular characteristics
-of how it supports types, constants, and so on.
-Much of this is left up to the implementation by the various
-Fortran standards and accepted practice in the industry.
-
-The GNU Fortran @emph{language} is described below.
-Much of the material is organized along the same lines
-as the ANSI FORTRAN 77 standard itself.
-
-@xref{Other Dialects}, for information on features @command{g77} supports
-that are not part of the GNU Fortran language.
-
-@emph{Note}: This portion of the documentation definitely needs a lot
-of work!
-
-@menu
-Relationship to the ANSI FORTRAN 77 standard:
-* Direction of Language Development::  Where GNU Fortran is headed.
-* Standard Support::  Degree of support for the standard.
-
-Extensions to the ANSI FORTRAN 77 standard:
-* Conformance::
-* Notation Used::
-* Terms and Concepts::
-* Characters Lines Sequence::
-* Data Types and Constants::
-* Expressions::
-* Specification Statements::
-* Control Statements::
-* Functions and Subroutines::
-* Scope and Classes of Names::
-* I/O::
-* Fortran 90 Features::
-@end menu
-
-@node Direction of Language Development
-@section Direction of Language Development
-@cindex direction of language development
-@cindex features, language
-@cindex language, features
-
-The purpose of the following description of the GNU Fortran
-language is to promote wide portability of GNU Fortran programs.
-
-GNU Fortran is an evolving language, due to the
-fact that @command{g77} itself is in beta test.
-Some current features of the language might later
-be redefined as dialects of Fortran supported by @command{g77}
-when better ways to express these features are added to @command{g77},
-for example.
-Such features would still be supported by
-@command{g77}, but would be available only when
-one or more command-line options were used.
-
-The GNU Fortran @emph{language} is distinct from the
-GNU Fortran @emph{compilation system} (@command{g77}).
-
-For example, @command{g77} supports various dialects of
-Fortran---in a sense, these are languages other than
-GNU Fortran---though its primary
-purpose is to support the GNU Fortran language, which also is
-described in its documentation and by its implementation.
-
-On the other hand, non-GNU compilers might offer
-support for the GNU Fortran language, and are encouraged
-to do so.
-
-Currently, the GNU Fortran language is a fairly fuzzy object.
-It represents something of a cross between what @command{g77} accepts
-when compiling using the prevailing defaults and what this
-document describes as being part of the language.
-
-Future versions of @command{g77} are expected to clarify the
-definition of the language in the documentation.
-Often, this will mean adding new features to the language, in the form
-of both new documentation and new support in @command{g77}.
-However, it might occasionally mean removing a feature
-from the language itself to ``dialect'' status.
-In such a case, the documentation would be adjusted
-to reflect the change, and @command{g77} itself would likely be changed
-to require one or more command-line options to continue supporting
-the feature.
-
-The development of the GNU Fortran language is intended to strike
-a balance between:
-
-@itemize @bullet
-@item
-Serving as a mostly-upwards-compatible language from the
-de facto UNIX Fortran dialect as supported by @command{f77}.
-
-@item
-Offering new, well-designed language features.
-Attributes of such features include
-not making existing code any harder to read
-(for those who might be unaware that the new
-features are not in use) and
-not making state-of-the-art
-compilers take longer to issue diagnostics,
-among others.
-
-@item
-Supporting existing, well-written code without gratuitously
-rejecting non-standard constructs, regardless of the origin
-of the code (its dialect).
-
-@item
-Offering default behavior and command-line options to reduce
-and, where reasonable, eliminate the need for programmers to make
-any modifications to code that already works in existing
-production environments.
-
-@item
-Diagnosing constructs that have different meanings in different
-systems, languages, and dialects, while offering clear,
-less ambiguous ways to express each of the different meanings
-so programmers can change their code appropriately.
-@end itemize
-
-One of the biggest practical challenges for the developers of the
-GNU Fortran language is meeting the sometimes contradictory demands
-of the above items.
-
-For example, a feature might be widely used in one popular environment,
-but the exact same code that utilizes that feature might not work
-as expected---perhaps it might mean something entirely different---in
-another popular environment.
-
-Traditionally, Fortran compilers---even portable ones---have solved this
-problem by simply offering the appropriate feature to users of
-the respective systems.
-This approach treats users of various Fortran systems and dialects
-as remote ``islands'', or camps, of programmers, and assume that these
-camps rarely come into contact with each other (or,
-especially, with each other's code).
-
-Project GNU takes a radically different approach to software and language
-design, in that it assumes that users of GNU software do not necessarily
-care what kind of underlying system they are using, regardless
-of whether they are using software (at the user-interface
-level) or writing it (for example, writing Fortran or C code).
-
-As such, GNU users rarely need consider just what kind of underlying
-hardware (or, in many cases, operating system) they are using at any
-particular time.
-They can use and write software designed for a general-purpose,
-widely portable, heterogeneous environment---the GNU environment.
-
-In line with this philosophy, GNU Fortran must evolve into a product
-that is widely ported and portable not only in the sense that it can
-be successfully built, installed, and run by users, but in the larger
-sense that its users can use it in the same way, and expect largely the
-same behaviors from it, regardless of the kind of system they are using
-at any particular time.
-
-This approach constrains the solutions @command{g77} can use to resolve
-conflicts between various camps of Fortran users.
-If these two camps disagree about what a particular construct should
-mean, @command{g77} cannot simply be changed to treat that particular construct as
-having one meaning without comment (such as a warning), lest the users
-expecting it to have the other meaning are unpleasantly surprised that
-their code misbehaves when executed.
-
-The use of the ASCII backslash character in character constants is
-an excellent (and still somewhat unresolved) example of this kind of
-controversy.
-@xref{Backslash in Constants}.
-Other examples are likely to arise in the future, as @command{g77} developers
-strive to improve its ability to accept an ever-wider variety of existing
-Fortran code without requiring significant modifications to said code.
-
-Development of GNU Fortran is further constrained by the desire
-to avoid requiring programmers to change their code.
-This is important because it allows programmers, administrators,
-and others to more faithfully evaluate and validate @command{g77}
-(as an overall product and as new versions are distributed)
-without having to support multiple versions of their programs
-so that they continue to work the same way on their existing
-systems (non-GNU perhaps, but possibly also earlier versions
-of @command{g77}).
-
-@node Standard Support
-@section ANSI FORTRAN 77 Standard Support
-@cindex ANSI FORTRAN 77 support
-@cindex standard, support for
-@cindex support, FORTRAN 77
-@cindex compatibility, FORTRAN 77
-@cindex FORTRAN 77 compatibility
-
-GNU Fortran supports ANSI FORTRAN 77 with the following caveats.
-In summary, the only ANSI FORTRAN 77 features @command{g77} doesn't
-support are those that are probably rarely used in actual code,
-some of which are explicitly disallowed by the Fortran 90 standard.
-
-@menu
-* No Passing External Assumed-length::  CHAR*(*) CFUNC restriction.
-* No Passing Dummy Assumed-length::     CHAR*(*) CFUNC restriction.
-* No Pathological Implied-DO::          No @samp{((@dots{}, I=@dots{}), I=@dots{})}.
-* No Useless Implied-DO::               No @samp{(A, I=1, 1)}.
-@end menu
-
-@node No Passing External Assumed-length
-@subsection No Passing External Assumed-length
-
-@command{g77} disallows passing of an external procedure
-as an actual argument if the procedure's
-type is declared @code{CHARACTER*(*)}.  For example:
-
-@example
-CHARACTER*(*) CFUNC
-EXTERNAL CFUNC
-CALL FOO(CFUNC)
-END
-@end example
-
-@noindent
-It isn't clear whether the standard considers this conforming.
-
-@node No Passing Dummy Assumed-length
-@subsection No Passing Dummy Assumed-length
-
-@command{g77} disallows passing of a dummy procedure
-as an actual argument if the procedure's
-type is declared @code{CHARACTER*(*)}.
-
-@example
-SUBROUTINE BAR(CFUNC)
-CHARACTER*(*) CFUNC
-EXTERNAL CFUNC
-CALL FOO(CFUNC)
-END
-@end example
-
-@noindent
-It isn't clear whether the standard considers this conforming.
-
-@node No Pathological Implied-DO
-@subsection No Pathological Implied-DO
-
-The @code{DO} variable for an implied-@code{DO} construct in a
-@code{DATA} statement may not be used as the @code{DO} variable
-for an outer implied-@code{DO} construct.  For example, this
-fragment is disallowed by @command{g77}:
-
-@smallexample
-DATA ((A(I, I), I= 1, 10), I= 1, 10) /@dots{}/
-@end smallexample
-
-@noindent
-This also is disallowed by Fortran 90, as it offers no additional
-capabilities and would have a variety of possible meanings.
-
-Note that it is @emph{very} unlikely that any production Fortran code
-tries to use this unsupported construct.
-
-@node No Useless Implied-DO
-@subsection No Useless Implied-DO
-
-An array element initializer in an implied-@code{DO} construct in a
-@code{DATA} statement must contain at least one reference to the @code{DO}
-variables of each outer implied-@code{DO} construct.  For example,
-this fragment is disallowed by @command{g77}:
-
-@smallexample
-DATA (A, I= 1, 1) /1./
-@end smallexample
-
-@noindent
-This also is disallowed by Fortran 90, as FORTRAN 77's more permissive
-requirements offer no additional capabilities.
-However, @command{g77} doesn't necessarily diagnose all cases
-where this requirement is not met.
-
-Note that it is @emph{very} unlikely that any production Fortran code
-tries to use this unsupported construct.
-
-@node Conformance
-@section Conformance
-
-(The following information augments or overrides the information in
-Section 1.4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 1 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-The definition of the GNU Fortran language is akin to that of
-the ANSI FORTRAN 77 language in that it does not generally require
-conforming implementations to diagnose cases where programs do
-not conform to the language.
-
-However, @command{g77} as a compiler is being developed in a way that
-is intended to enable it to diagnose such cases in an easy-to-understand
-manner.
-
-A program that conforms to the GNU Fortran language should, when
-compiled, linked, and executed using a properly installed @command{g77}
-system, perform as described by the GNU Fortran language definition.
-Reasons for different behavior include, among others:
-
-@itemize @bullet
-@item
-Use of resources (memory---heap, stack, and so on; disk space; CPU
-time; etc.) exceeds those of the system.
-
-@item
-Range and/or precision of calculations required by the program
-exceeds that of the system.
-
-@item
-Excessive reliance on behaviors that are system-dependent
-(non-portable Fortran code).
-
-@item
-Bugs in the program.
-
-@item
-Bug in @command{g77}.
-
-@item
-Bugs in the system.
-@end itemize
-
-Despite these ``loopholes'', the availability of a clear specification
-of the language of programs submitted to @command{g77}, as this document
-is intended to provide, is considered an important aspect of providing
-a robust, clean, predictable Fortran implementation.
-
-The definition of the GNU Fortran language, while having no special
-legal status, can therefore be viewed as a sort of contract, or agreement.
-This agreement says, in essence, ``if you write a program in this language,
-and run it in an environment (such as a @command{g77} system) that supports
-this language, the program should behave in a largely predictable way''.
-
-@node Notation Used
-@section Notation Used in This Chapter
-
-(The following information augments or overrides the information in
-Section 1.5 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 1 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-In this chapter, ``must'' denotes a requirement, ``may'' denotes permission,
-and ``must not'' and ``may not'' denote prohibition.
-Terms such as ``might'', ``should'', and ``can'' generally add little or
-nothing in the way of weight to the GNU Fortran language itself,
-but are used to explain or illustrate the language.
-
-For example:
-
-@display
-``The @code{FROBNITZ} statement must precede all executable
-statements in a program unit, and may not specify any dummy
-arguments.  It may specify local or common variables and arrays.
-Its use should be limited to portions of the program designed to
-be non-portable and system-specific, because it might cause the
-containing program unit to behave quite differently on different
-systems.''
-@end display
-
-Insofar as the GNU Fortran language is specified,
-the requirements and permissions denoted by the above sample statement
-are limited to the placement of the statement and the kinds of
-things it may specify.
-The rest of the statement---the content regarding non-portable portions
-of the program and the differing behavior of program units containing
-the @code{FROBNITZ} statement---does not pertain the GNU Fortran
-language itself.
-That content offers advice and warnings about the @code{FROBNITZ}
-statement.
-
-@emph{Remember:} The GNU Fortran language definition specifies
-both what constitutes a valid GNU Fortran program and how,
-given such a program, a valid GNU Fortran implementation is
-to interpret that program.
-
-It is @emph{not} incumbent upon a valid GNU Fortran implementation
-to behave in any particular way, any consistent way, or any
-predictable way when it is asked to interpret input that is
-@emph{not} a valid GNU Fortran program.
-
-Such input is said to have @dfn{undefined} behavior when
-interpreted by a valid GNU Fortran implementation, though
-an implementation may choose to specify behaviors for some
-cases of inputs that are not valid GNU Fortran programs.
-
-Other notation used herein is that of the GNU texinfo format,
-which is used to generate printed hardcopy, on-line hypertext
-(Info), and on-line HTML versions, all from a single source
-document.
-This notation is used as follows:
-
-@itemize @bullet
-@item
-Keywords defined by the GNU Fortran language are shown
-in uppercase, as in: @code{COMMON}, @code{INTEGER}, and
-@code{BLOCK DATA}.
-
-Note that, in practice, many Fortran programs are written
-in lowercase---uppercase is used in this manual as a
-means to readily distinguish keywords and sample Fortran-related
-text from the prose in this document.
-
-@item
-Portions of actual sample program, input, or output text
-look like this: @samp{Actual program text}.
-
-Generally, uppercase is used for all Fortran-specific and
-Fortran-related text, though this does not always include
-literal text within Fortran code.
-
-For example: @samp{PRINT *, 'My name is Bob'}.
-
-@item
-A metasyntactic variable---that is, a name used in this document
-to serve as a placeholder for whatever text is used by the
-user or programmer---appears as shown in the following example:
-
-``The @code{INTEGER @var{ivar}} statement specifies that
-@var{ivar} is a variable or array of type @code{INTEGER}.''
-
-In the above example, any valid text may be substituted for
-the metasyntactic variable @var{ivar} to make the statement
-apply to a specific instance, as long as the same text is
-substituted for @emph{both} occurrences of @var{ivar}.
-
-@item
-Ellipses (``@dots{}'') are used to indicate further text that
-is either unimportant or expanded upon further, elsewhere.
-
-@item
-Names of data types are in the style of Fortran 90, in most
-cases.
-
-@xref{Kind Notation}, for information on the relationship
-between Fortran 90 nomenclature (such as @code{INTEGER(KIND=1)})
-and the more traditional, less portably concise nomenclature
-(such as @code{INTEGER*4}).
-@end itemize
-
-@node Terms and Concepts
-@section Fortran Terms and Concepts
-
-(The following information augments or overrides the information in
-Chapter 2 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 2 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* Syntactic Items::
-* Statements Comments Lines::
-* Scope of Names and Labels::
-@end menu
-
-@node Syntactic Items
-@subsection Syntactic Items
-
-(Corresponds to Section 2.2 of ANSI X3.9-1978 FORTRAN 77.)
-
-@cindex limits, lengths of names
-In GNU Fortran, a symbolic name is at least one character long,
-and has no arbitrary upper limit on length.
-However, names of entities requiring external linkage (such as
-external functions, external subroutines, and @code{COMMON} areas)
-might be restricted to some arbitrary length by the system.
-Such a restriction is no more constrained than that of one
-through six characters.
-
-Underscores (@samp{_}) are accepted in symbol names after the first
-character (which must be a letter).
-
-@node Statements Comments Lines
-@subsection Statements, Comments, and Lines
-
-(Corresponds to Section 2.3 of ANSI X3.9-1978 FORTRAN 77.)
-
-@cindex trailing comment
-@cindex comment
-@cindex characters, comment
-@cindex !
-@cindex exclamation point
-@cindex continuation character
-@cindex characters, continuation
-Use of an exclamation point (@samp{!}) to begin a
-trailing comment (a comment that extends to the end of the same
-source line) is permitted under the following conditions:
-
-@itemize @bullet
-@item
-The exclamation point does not appear in column 6.
-Otherwise, it is treated as an indicator of a continuation
-line.
-
-@item
-The exclamation point appears outside a character or Hollerith
-constant.
-Otherwise, the exclamation point is considered part of the
-constant.
-
-@item
-The exclamation point appears to the left of any other possible
-trailing comment.
-That is, a trailing comment may contain exclamation points
-in their commentary text.
-@end itemize
-
-@cindex ;
-@cindex semicolon
-@cindex statements, separated by semicolon
-Use of a semicolon (@samp{;}) as a statement separator
-is permitted under the following conditions:
-
-@itemize @bullet
-@item
-The semicolon appears outside a character or Hollerith
-constant.
-Otherwise, the semicolon is considered part of the
-constant.
-
-@item
-The semicolon appears to the left of a trailing comment.
-Otherwise, the semicolon is considered part of that
-comment.
-
-@item
-Neither a logical @code{IF} statement nor a non-construct
-@code{WHERE} statement (a Fortran 90 feature) may be
-followed (in the same, possibly continued, line) by
-a semicolon used as a statement separator.
-
-This restriction avoids the confusion
-that can result when reading a line such as:
-
-@smallexample
-IF (VALIDP) CALL FOO; CALL BAR
-@end smallexample
-
-@noindent
-Some readers might think the @samp{CALL BAR} is executed
-only if @samp{VALIDP} is @code{.TRUE.}, while others might
-assume its execution is unconditional.
-
-(At present, @command{g77} does not diagnose code that
-violates this restriction.)
-@end itemize
-
-@node Scope of Names and Labels
-@subsection Scope of Symbolic Names and Statement Labels
-@cindex scope
-
-(Corresponds to Section 2.9 of ANSI X3.9-1978 FORTRAN 77.)
-
-Included in the list of entities that have a scope of a
-program unit are construct names (a Fortran 90 feature).
-@xref{Construct Names}, for more information.
-
-@node Characters Lines Sequence
-@section Characters, Lines, and Execution Sequence
-
-(The following information augments or overrides the information in
-Chapter 3 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 3 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* Character Set::
-* Lines::
-* Continuation Line::
-* Statements::
-* Statement Labels::
-* Order::
-* INCLUDE::
-* Cpp-style directives::
-@end menu
-
-@node Character Set
-@subsection GNU Fortran Character Set
-@cindex characters
-
-(Corresponds to Section 3.1 of ANSI X3.9-1978 FORTRAN 77.)
-
-Letters include uppercase letters (the twenty-six characters
-of the English alphabet) and lowercase letters (their lowercase
-equivalent).
-Generally, lowercase letters may be used in place of uppercase
-letters, though in character and Hollerith constants, they
-are distinct.
-
-Special characters include:
-
-@itemize @bullet
-@item
-@cindex ;
-@cindex semicolon
-Semicolon (@samp{;})
-
-@item
-@cindex !
-@cindex exclamation point
-Exclamation point (@samp{!})
-
-@item
-@cindex "
-@cindex double quote
-Double quote (@samp{"})
-
-@item
-@cindex \
-@cindex backslash
-Backslash (@samp{\})
-
-@item
-@cindex ?
-@cindex question mark
-Question mark (@samp{?})
-
-@item
-@cindex #
-@cindex hash mark
-@cindex pound sign
-Hash mark (@samp{#})
-
-@item
-@cindex &
-@cindex ampersand
-Ampersand (@samp{&})
-
-@item
-@cindex %
-@cindex percent sign
-Percent sign (@samp{%})
-
-@item
-@cindex _
-@cindex underscore
-Underscore (@samp{_})
-
-@item
-@cindex <
-@cindex open angle
-@cindex left angle
-@cindex open bracket
-@cindex left bracket
-Open angle (@samp{<})
-
-@item
-@cindex >
-@cindex close angle
-@cindex right angle
-@cindex close bracket
-@cindex right bracket
-Close angle (@samp{>})
-
-@item
-The FORTRAN 77 special characters (@key{SPC}, @samp{=},
-@samp{+}, @samp{-}, @samp{*}, @samp{/}, @samp{(},
-@samp{)}, @samp{,}, @samp{.}, @samp{$}, @samp{'},
-and @samp{:})
-@end itemize
-
-@cindex blank
-@cindex space
-@cindex SPC
-Note that this document refers to @key{SPC} as @dfn{space},
-while X3.9-1978 FORTRAN 77 refers to it as @dfn{blank}.
-
-@node Lines
-@subsection Lines
-@cindex lines
-@cindex source file format
-@cindex source format
-@cindex file, source
-@cindex source code
-@cindex code, source
-@cindex fixed form
-@cindex free form
-
-(Corresponds to Section 3.2 of ANSI X3.9-1978 FORTRAN 77.)
-
-The way a Fortran compiler views source files depends entirely on the
-implementation choices made for the compiler, since those choices
-are explicitly left to the implementation by the published Fortran
-standards.
-
-The GNU Fortran language mandates a view applicable to UNIX-like
-text files---files that are made up of an arbitrary number of lines,
-each with an arbitrary number of characters (sometimes called stream-based
-files).
-
-This view does not apply to types of files that are specified as
-having a particular number of characters on every single line (sometimes
-referred to as record-based files).
-
-Because a ``line in a program unit is a sequence of 72 characters'',
-to quote X3.9-1978, the GNU Fortran language specifies that a
-stream-based text file is translated to GNU Fortran lines as follows:
-
-@itemize @bullet
-@item
-A newline in the file is the character that represents the end of
-a line of text to the underlying system.
-For example, on ASCII-based systems, a newline is the @key{NL}
-character, which has ASCII value 10 (decimal).
-
-@item
-Each newline in the file serves to end the line of text that precedes
-it (and that does not contain a newline).
-
-@item
-The end-of-file marker (@code{EOF}) also serves to end the line
-of text that precedes it (and that does not contain a newline).
-
-@item
-@cindex blank
-@cindex space
-@cindex SPC
-Any line of text that is shorter than 72 characters is padded to that length
-with spaces (called ``blanks'' in the standard).
-
-@item
-Any line of text that is longer than 72 characters is truncated to that
-length, but the truncated remainder must consist entirely of spaces.
-
-@item
-Characters other than newline and the GNU Fortran character set
-are invalid.
-@end itemize
-
-For the purposes of the remainder of this description of the GNU
-Fortran language, the translation described above has already
-taken place, unless otherwise specified.
-
-The result of the above translation is that the source file appears,
-in terms of the remainder of this description of the GNU Fortran language,
-as if it had an arbitrary
-number of 72-character lines, each character being among the GNU Fortran
-character set.
-
-For example, if the source file itself has two newlines in a row,
-the second newline becomes, after the above translation, a single
-line containing 72 spaces.
-
-@node Continuation Line
-@subsection Continuation Line
-@cindex continuation line, number of
-@cindex lines, continuation
-@cindex number of continuation lines
-@cindex limits, continuation lines
-
-(Corresponds to Section 3.2.3 of ANSI X3.9-1978 FORTRAN 77.)
-
-A continuation line is any line that both
-
-@itemize @bullet
-@item
-Contains a continuation character, and
-
-@item
-Contains only spaces in columns 1 through 5
-@end itemize
-
-A continuation character is any character of the GNU Fortran character set
-other than space (@key{SPC}) or zero (@samp{0})
-in column 6, or a digit (@samp{0} through @samp{9}) in column
-7 through 72 of a line that has only spaces to the left of that
-digit.
-
-The continuation character is ignored as far as the content of
-the statement is concerned.
-
-The GNU Fortran language places no limit on the number of
-continuation lines in a statement.
-In practice, the limit depends on a variety of factors, such as
-available memory, statement content, and so on, but no
-GNU Fortran system may impose an arbitrary limit.
-
-@node Statements
-@subsection Statements
-
-(Corresponds to Section 3.3 of ANSI X3.9-1978 FORTRAN 77.)
-
-Statements may be written using an arbitrary number of continuation
-lines.
-
-Statements may be separated using the semicolon (@samp{;}), except
-that the logical @code{IF} and non-construct @code{WHERE} statements
-may not be separated from subsequent statements using only a semicolon
-as statement separator.
-
-The @code{END PROGRAM}, @code{END SUBROUTINE}, @code{END FUNCTION},
-and @code{END BLOCK DATA} statements are alternatives to the @code{END}
-statement.
-These alternatives may be written as normal statements---they are not
-subject to the restrictions of the @code{END} statement.
-
-However, no statement other than @code{END} may have an initial line
-that appears to be an @code{END} statement---even @code{END PROGRAM},
-for example, must not be written as:
-
-@example
-      END
-     &PROGRAM
-@end example
-
-@node Statement Labels
-@subsection Statement Labels
-
-(Corresponds to Section 3.4 of ANSI X3.9-1978 FORTRAN 77.)
-
-A statement separated from its predecessor via a semicolon may be
-labeled as follows:
-
-@itemize @bullet
-@item
-The semicolon is followed by the label for the statement,
-which in turn follows the label.
-
-@item
-The label must be no more than five digits in length.
-
-@item
-The first digit of the label for the statement is not
-the first non-space character on a line.
-Otherwise, that character is treated as a continuation
-character.
-@end itemize
-
-A statement may have only one label defined for it.
-
-@node Order
-@subsection Order of Statements and Lines
-
-(Corresponds to Section 3.5 of ANSI X3.9-1978 FORTRAN 77.)
-
-Generally, @code{DATA} statements may precede executable statements.
-However, specification statements pertaining to any entities
-initialized by a @code{DATA} statement must precede that @code{DATA}
-statement.
-For example,
-after @samp{DATA I/1/}, @samp{INTEGER I} is not permitted, but
-@samp{INTEGER J} is permitted.
-
-The last line of a program unit may be an @code{END} statement,
-or may be:
-
-@itemize @bullet
-@item
-An @code{END PROGRAM} statement, if the program unit is a main program.
-
-@item
-An @code{END SUBROUTINE} statement, if the program unit is a subroutine.
-
-@item
-An @code{END FUNCTION} statement, if the program unit is a function.
-
-@item
-An @code{END BLOCK DATA} statement, if the program unit is a block data.
-@end itemize
-
-@node INCLUDE
-@subsection Including Source Text
-@cindex INCLUDE directive
-
-Additional source text may be included in the processing of
-the source file via the @code{INCLUDE} directive:
-
-@example
-INCLUDE @var{filename}
-@end example
-
-@noindent
-The source text to be included is identified by @var{filename},
-which is a literal GNU Fortran character constant.
-The meaning and interpretation of @var{filename} depends on the
-implementation, but typically is a filename.
-
-(@command{g77} treats it as a filename that it searches for
-in the current directory and/or directories specified
-via the @option{-I} command-line option.)
-
-The effect of the @code{INCLUDE} directive is as if the
-included text directly replaced the directive in the source
-file prior to interpretation of the program.
-Included text may itself use @code{INCLUDE}.
-The depth of nested @code{INCLUDE} references depends on
-the implementation, but typically is a positive integer.
-
-This virtual replacement treats the statements and @code{INCLUDE}
-directives in the included text as syntactically distinct from
-those in the including text.
-
-Therefore, the first non-comment line of the included text
-must not be a continuation line.
-The included text must therefore have, after the non-comment
-lines, either an initial line (statement), an @code{INCLUDE}
-directive, or nothing (the end of the included text).
-
-Similarly, the including text may end the @code{INCLUDE}
-directive with a semicolon or the end of the line, but it
-cannot follow an @code{INCLUDE} directive at the end of its
-line with a continuation line.
-Thus, the last statement in an included text may not be
-continued.
-
-Any statements between two @code{INCLUDE} directives on the
-same line are treated as if they appeared in between the
-respective included texts.
-For example:
-
-@smallexample
-INCLUDE 'A'; PRINT *, 'B'; INCLUDE 'C'; END PROGRAM
-@end smallexample
-
-@noindent
-If the text included by @samp{INCLUDE 'A'} constitutes
-a @samp{PRINT *, 'A'} statement and the text included by
-@samp{INCLUDE 'C'} constitutes a @samp{PRINT *, 'C'} statement,
-then the output of the above sample program would be
-
-@example
-A
-B
-C
-@end example
-
-@noindent
-(with suitable allowances for how an implementation defines
-its handling of output).
-
-Included text must not include itself directly or indirectly,
-regardless of whether the @var{filename} used to reference
-the text is the same.
-
-Note that @code{INCLUDE} is @emph{not} a statement.
-As such, it is neither a non-executable or executable
-statement.
-However, if the text it includes constitutes one or more
-executable statements, then the placement of @code{INCLUDE}
-is subject to effectively the same restrictions as those
-on executable statements.
-
-An @code{INCLUDE} directive may be continued across multiple
-lines as if it were a statement.
-This permits long names to be used for @var{filename}.
-
-@node Cpp-style directives
-@subsection Cpp-style directives
-@cindex #
-@cindex preprocessor
-
-@code{cpp} output-style @code{#} directives
-(@pxref{C Preprocessor Output,,, cpp, The C Preprocessor})
-are recognized by the compiler even
-when the preprocessor isn't run on the input (as it is when compiling
-@samp{.F} files).  (Note the distinction between these @command{cpp}
-@code{#} @emph{output} directives and @code{#line} @emph{input}
-directives.)
-
-@node Data Types and Constants
-@section Data Types and Constants
-
-(The following information augments or overrides the information in
-Chapter 4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 4 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-To more concisely express the appropriate types for
-entities, this document uses the more concise
-Fortran 90 nomenclature such as @code{INTEGER(KIND=1)}
-instead of the more traditional, but less portably concise,
-byte-size-based nomenclature such as @code{INTEGER*4},
-wherever reasonable.
-
-When referring to generic types---in contexts where the
-specific precision and range of a type are not important---this
-document uses the generic type names @code{INTEGER}, @code{LOGICAL},
-@code{REAL}, @code{COMPLEX}, and @code{CHARACTER}.
-
-In some cases, the context requires specification of a
-particular type.
-This document uses the @samp{KIND=} notation to accomplish
-this throughout, sometimes supplying the more traditional
-notation for clarification, though the traditional notation
-might not work the same way on all GNU Fortran implementations.
-
-Use of @samp{KIND=} makes this document more concise because
-@command{g77} is able to define values for @samp{KIND=} that
-have the same meanings on all systems, due to the way the
-Fortran 90 standard specifies these values are to be used.
-
-(In particular, that standard permits an implementation to
-arbitrarily assign nonnegative values.
-There are four distinct sets of assignments: one to the @code{CHARACTER}
-type; one to the @code{INTEGER} type; one to the @code{LOGICAL} type;
-and the fourth to both the @code{REAL} and @code{COMPLEX} types.
-Implementations are free to assign these values in any order,
-leave gaps in the ordering of assignments, and assign more than
-one value to a representation.)
-
-This makes @samp{KIND=} values superior to the values used
-in non-standard statements such as @samp{INTEGER*4}, because
-the meanings of the values in those statements vary from machine
-to machine, compiler to compiler, even operating system to
-operating system.
-
-However, use of @samp{KIND=} is @emph{not} generally recommended
-when writing portable code (unless, for example, the code is
-going to be compiled only via @command{g77}, which is a widely
-ported compiler).
-GNU Fortran does not yet have adequate language constructs to
-permit use of @samp{KIND=} in a fashion that would make the
-code portable to Fortran 90 implementations; and, this construct
-is known to @emph{not} be accepted by many popular FORTRAN 77
-implementations, so it cannot be used in code that is to be ported
-to those.
-
-The distinction here is that this document is able to use
-specific values for @samp{KIND=} to concisely document the
-types of various operations and operands.
-
-A Fortran program should use the FORTRAN 77 designations for the
-appropriate GNU Fortran types---such as @code{INTEGER} for
-@code{INTEGER(KIND=1)}, @code{REAL} for @code{REAL(KIND=1)},
-and @code{DOUBLE COMPLEX} for @code{COMPLEX(KIND=2)}---and,
-where no such designations exist, make use of appropriate
-techniques (preprocessor macros, parameters, and so on)
-to specify the types in a fashion that may be easily adjusted
-to suit each particular implementation to which the program
-is ported.
-(These types generally won't need to be adjusted for ports of
-@command{g77}.)
-
-Further details regarding GNU Fortran data types and constants
-are provided below.
-
-@menu
-* Types::
-* Constants::
-* Integer Type::
-* Character Type::
-@end menu
-
-@node Types
-@subsection Data Types
-
-(Corresponds to Section 4.1 of ANSI X3.9-1978 FORTRAN 77.)
-
-GNU Fortran supports these types:
-
-@enumerate
-@item
-Integer (generic type @code{INTEGER})
-
-@item
-Real (generic type @code{REAL})
-
-@item
-Double precision
-
-@item
-Complex (generic type @code{COMPLEX})
-
-@item
-Logical (generic type @code{LOGICAL})
-
-@item
-Character (generic type @code{CHARACTER})
-
-@item
-Double Complex
-@end enumerate
-
-(The types numbered 1 through 6 above are standard FORTRAN 77 types.)
-
-The generic types shown above are referred to in this document
-using only their generic type names.
-Such references usually indicate that any specific type (kind)
-of that generic type is valid.
-
-For example, a context described in this document as accepting
-the @code{COMPLEX} type also is likely to accept the
-@code{DOUBLE COMPLEX} type.
-
-The GNU Fortran language supports three ways to specify
-a specific kind of a generic type.
-
-@menu
-* Double Notation::  As in @code{DOUBLE COMPLEX}.
-* Star Notation::    As in @code{INTEGER*4}.
-* Kind Notation::    As in @code{INTEGER(KIND=1)}.
-@end menu
-
-@node Double Notation
-@subsubsection Double Notation
-
-The GNU Fortran language supports two uses of the keyword
-@code{DOUBLE} to specify a specific kind of type:
-
-@itemize @bullet
-@item
-@code{DOUBLE PRECISION}, equivalent to @code{REAL(KIND=2)}
-
-@item
-@code{DOUBLE COMPLEX}, equivalent to @code{COMPLEX(KIND=2)}
-@end itemize
-
-Use one of the above forms where a type name is valid.
-
-While use of this notation is popular, it doesn't scale
-well in a language or dialect rich in intrinsic types,
-as is the case for the GNU Fortran language (especially
-planned future versions of it).
-
-After all, one rarely sees type names such as @samp{DOUBLE INTEGER},
-@samp{QUADRUPLE REAL}, or @samp{QUARTER INTEGER}.
-Instead, @code{INTEGER*8}, @code{REAL*16}, and @code{INTEGER*1}
-often are substituted for these, respectively, even though they
-do not always have the same meanings on all systems.
-(And, the fact that @samp{DOUBLE REAL} does not exist as such
-is an inconsistency.)
-
-Therefore, this document uses ``double notation'' only on occasion
-for the benefit of those readers who are accustomed to it.
-
-@node Star Notation
-@subsubsection Star Notation
-@cindex *@var{n} notation
-
-The following notation specifies the storage size for a type:
-
-@smallexample
-@var{generic-type}*@var{n}
-@end smallexample
-
-@noindent
-@var{generic-type} must be a generic type---one of
-@code{INTEGER}, @code{REAL}, @code{COMPLEX}, @code{LOGICAL},
-or @code{CHARACTER}.
-@var{n} must be one or more digits comprising a decimal
-integer number greater than zero.
-
-Use the above form where a type name is valid.
-
-The @samp{*@var{n}} notation specifies that the amount of storage
-occupied by variables and array elements of that type is @var{n}
-times the storage occupied by a @code{CHARACTER*1} variable.
-
-This notation might indicate a different degree of precision and/or
-range for such variables and array elements, and the functions that
-return values of types using this notation.
-It does not limit the precision or range of values of that type
-in any particular way---use explicit code to do that.
-
-Further, the GNU Fortran language requires no particular values
-for @var{n} to be supported by an implementation via the @samp{*@var{n}}
-notation.
-@command{g77} supports @code{INTEGER*1} (as @code{INTEGER(KIND=3)})
-on all systems, for example,
-but not all implementations are required to do so, and @command{g77}
-is known to not support @code{REAL*1} on most (or all) systems.
-
-As a result, except for @var{generic-type} of @code{CHARACTER},
-uses of this notation should be limited to isolated
-portions of a program that are intended to handle system-specific
-tasks and are expected to be non-portable.
-
-(Standard FORTRAN 77 supports the @samp{*@var{n}} notation for
-only @code{CHARACTER}, where it signifies not only the amount
-of storage occupied, but the number of characters in entities
-of that type.
-However, almost all Fortran compilers have supported this
-notation for generic types, though with a variety of meanings
-for @var{n}.)
-
-Specifications of types using the @samp{*@var{n}} notation
-always are interpreted as specifications of the appropriate
-types described in this document using the @samp{KIND=@var{n}}
-notation, described below.
-
-While use of this notation is popular, it doesn't serve well
-in the context of a widely portable dialect of Fortran, such as
-the GNU Fortran language.
-
-For example, even on one particular machine, two or more popular
-Fortran compilers might well disagree on the size of a type
-declared @code{INTEGER*2} or @code{REAL*16}.
-Certainly there
-is known to be disagreement over such things among Fortran
-compilers on @emph{different} systems.
-
-Further, this notation offers no elegant way to specify sizes
-that are not even multiples of the ``byte size'' typically
-designated by @code{INTEGER*1}.
-Use of ``absurd'' values (such as @code{INTEGER*1000}) would
-certainly be possible, but would perhaps be stretching the original
-intent of this notation beyond the breaking point in terms
-of widespread readability of documentation and code making use
-of it.
-
-Therefore, this document uses ``star notation'' only on occasion
-for the benefit of those readers who are accustomed to it.
-
-@node Kind Notation
-@subsubsection Kind Notation
-@cindex KIND= notation
-
-The following notation specifies the kind-type selector of a type:
-
-@smallexample
-@var{generic-type}(KIND=@var{n})
-@end smallexample
-
-@noindent
-Use the above form where a type name is valid.
-
-@var{generic-type} must be a generic type---one of
-@code{INTEGER}, @code{REAL}, @code{COMPLEX}, @code{LOGICAL},
-or @code{CHARACTER}.
-@var{n} must be an integer initialization expression that
-is a positive, nonzero value.
-
-Programmers are discouraged from writing these values directly
-into their code.
-Future versions of the GNU Fortran language will offer
-facilities that will make the writing of code portable
-to @command{g77} @emph{and} Fortran 90 implementations simpler.
-
-However, writing code that ports to existing FORTRAN 77
-implementations depends on avoiding the @samp{KIND=} construct.
-
-The @samp{KIND=} construct is thus useful in the context
-of GNU Fortran for two reasons:
-
-@itemize @bullet
-@item
-It provides a means to specify a type in a fashion that
-is portable across all GNU Fortran implementations (though
-not other FORTRAN 77 and Fortran 90 implementations).
-
-@item
-It provides a sort of Rosetta stone for this document to use
-to concisely describe the types of various operations and
-operands.
-@end itemize
-
-The values of @var{n} in the GNU Fortran language are
-assigned using a scheme that:
-
-@itemize @bullet
-@item
-Attempts to maximize the ability of readers
-of this document to quickly familiarize themselves
-with assignments for popular types
-
-@item
-Provides a unique value for each specific desired
-meaning
-
-@item
-Provides a means to automatically assign new values so
-they have a ``natural'' relationship to existing values,
-if appropriate, or, if no such relationship exists, will
-not interfere with future values assigned on the basis
-of such relationships
-
-@item
-Avoids using values that are similar to values used
-in the existing, popular @samp{*@var{n}} notation,
-to prevent readers from expecting that these implied
-correspondences work on all GNU Fortran implementations
-@end itemize
-
-The assignment system accomplishes this by assigning
-to each ``fundamental meaning'' of a specific type a
-unique prime number.
-Combinations of fundamental meanings---for example, a type
-that is two times the size of some other type---are assigned
-values of @var{n} that are the products of the values for
-those fundamental meanings.
-
-A prime value of @var{n} is never given more than one fundamental
-meaning, to avoid situations where some code or system
-cannot reasonably provide those meanings in the form of a
-single type.
-
-The values of @var{n} assigned so far are:
-
-@table @code
-@item KIND=0
-This value is reserved for future use.
-
-The planned future use is for this value to designate,
-explicitly, context-sensitive kind-type selection.
-For example, the expression @samp{1D0 * 0.1_0} would
-be equivalent to @samp{1D0 * 0.1D0}.
-
-@item KIND=1
-This corresponds to the default types for
-@code{REAL}, @code{INTEGER}, @code{LOGICAL}, @code{COMPLEX},
-and @code{CHARACTER}, as appropriate.
-
-These are the ``default'' types described in the Fortran 90 standard,
-though that standard does not assign any particular @samp{KIND=}
-value to these types.
-
-(Typically, these are @code{REAL*4}, @code{INTEGER*4},
-@code{LOGICAL*4}, and @code{COMPLEX*8}.)
-
-@item KIND=2
-This corresponds to types that occupy twice as much
-storage as the default types.
-@code{REAL(KIND=2)} is @code{DOUBLE PRECISION} (typically @code{REAL*8}),
-@code{COMPLEX(KIND=2)} is @code{DOUBLE COMPLEX} (typically @code{COMPLEX*16}),
-
-These are the ``double precision'' types described in the Fortran 90
-standard,
-though that standard does not assign any particular @samp{KIND=}
-value to these types.
-
-@var{n} of 4 thus corresponds to types that occupy four times
-as much storage as the default types, @var{n} of 8 to types that
-occupy eight times as much storage, and so on.
-
-The @code{INTEGER(KIND=2)} and @code{LOGICAL(KIND=2)} types
-are not necessarily supported by every GNU Fortran implementation.
-
-@item KIND=3
-This corresponds to types that occupy as much
-storage as the default @code{CHARACTER} type,
-which is the same effective type as @code{CHARACTER(KIND=1)}
-(making that type effectively the same as @code{CHARACTER(KIND=3)}).
-
-(Typically, these are @code{INTEGER*1} and @code{LOGICAL*1}.)
-
-@var{n} of 6 thus corresponds to types that occupy twice as
-much storage as the @var{n}=3 types, @var{n} of 12 to types
-that occupy four times as much storage, and so on.
-
-These are not necessarily supported by every GNU Fortran
-implementation.
-
-@item KIND=5
-This corresponds to types that occupy half the
-storage as the default (@var{n}=1) types.
-
-(Typically, these are @code{INTEGER*2} and @code{LOGICAL*2}.)
-
-@var{n} of 25 thus corresponds to types that occupy one-quarter
-as much storage as the default types.
-
-These are not necessarily supported by every GNU Fortran
-implementation.
-
-@item KIND=7
-@cindex pointers
-This is valid only as @code{INTEGER(KIND=7)} and
-denotes the @code{INTEGER} type that has the smallest
-storage size that holds a pointer on the system.
-
-A pointer representable by this type is capable of uniquely
-addressing a @code{CHARACTER*1} variable, array, array element,
-or substring.
-
-(Typically this is equivalent to @code{INTEGER*4} or,
-on 64-bit systems, @code{INTEGER*8}.
-In a compatible C implementation, it typically would
-be the same size and semantics of the C type @code{void *}.)
-@end table
-
-Note that these are @emph{proposed} correspondences and might change
-in future versions of @command{g77}---avoid writing code depending
-on them while @command{g77}, and therefore the GNU Fortran language
-it defines, is in beta testing.
-
-Values not specified in the above list are reserved to
-future versions of the GNU Fortran language.
-
-Implementation-dependent meanings will be assigned new,
-unique prime numbers so as to not interfere with other
-implementation-dependent meanings, and offer the possibility
-of increasing the portability of code depending on such
-types by offering support for them in other GNU Fortran
-implementations.
-
-Other meanings that might be given unique values are:
-
-@itemize @bullet
-@item
-Types that make use of only half their storage size for
-representing precision and range.
-
-For example, some compilers offer options that cause
-@code{INTEGER} types to occupy the amount of storage
-that would be needed for @code{INTEGER(KIND=2)} types, but the
-range remains that of @code{INTEGER(KIND=1)}.
-
-@item
-The IEEE single floating-point type.
-
-@item
-Types with a specific bit pattern (endianness), such as the
-little-endian form of @code{INTEGER(KIND=1)}.
-These could permit, conceptually, use of portable code and
-implementations on data files written by existing systems.
-@end itemize
-
-Future @emph{prime} numbers should be given meanings in as incremental
-a fashion as possible, to allow for flexibility and
-expressiveness in combining types.
-
-For example, instead of defining a prime number for little-endian
-IEEE doubles, one prime number might be assigned the meaning
-``little-endian'', another the meaning ``IEEE double'', and the
-value of @var{n} for a little-endian IEEE double would thus
-naturally be the product of those two respective assigned values.
-(It could even be reasonable to have IEEE values result from the
-products of prime values denoting exponent and fraction sizes
-and meanings, hidden bit usage, availability and representations
-of special values such as subnormals, infinities, and Not-A-Numbers
-(NaNs), and so on.)
-
-This assignment mechanism, while not inherently required for
-future versions of the GNU Fortran language, is worth using
-because it could ease management of the ``space'' of supported
-types much easier in the long run.
-
-The above approach suggests a mechanism for specifying inheritance
-of intrinsic (built-in) types for an entire, widely portable
-product line.
-It is certainly reasonable that, unlike programmers of other languages
-offering inheritance mechanisms that employ verbose names for classes
-and subclasses, along with graphical browsers to elucidate the
-relationships, Fortran programmers would employ
-a mechanism that works by multiplying prime numbers together
-and finding the prime factors of such products.
-
-Most of the advantages for the above scheme have been explained
-above.
-One disadvantage is that it could lead to the defining,
-by the GNU Fortran language, of some fairly large prime numbers.
-This could lead to the GNU Fortran language being declared
-``munitions'' by the United States Department of Defense.
-
-@node Constants
-@subsection Constants
-@cindex constants
-@cindex types, constants
-
-(Corresponds to Section 4.2 of ANSI X3.9-1978 FORTRAN 77.)
-
-A @dfn{typeless constant} has one of the following forms:
-
-@smallexample
-'@var{binary-digits}'B
-'@var{octal-digits}'O
-'@var{hexadecimal-digits}'Z
-'@var{hexadecimal-digits}'X
-@end smallexample
-
-@noindent
-@var{binary-digits}, @var{octal-digits}, and @var{hexadecimal-digits}
-are nonempty strings of characters in the set @samp{01}, @samp{01234567},
-and @samp{0123456789ABCDEFabcdef}, respectively.
-(The value for @samp{A} (and @samp{a}) is 10, for @samp{B} and @samp{b}
-is 11, and so on.)
-
-A prefix-radix constant, such as @samp{Z'ABCD'}, can optionally be
-treated as typeless.  @xref{Fortran Dialect Options,, Options
-Controlling Fortran Dialect}, for information on the
-@option{-ftypeless-boz} option.
-
-Typeless constants have values that depend on the context in which
-they are used.
-
-All other constants, called @dfn{typed constants}, are interpreted---converted
-to internal form---according to their inherent type.
-Thus, context is @emph{never} a determining factor for the type, and hence
-the interpretation, of a typed constant.
-(All constants in the ANSI FORTRAN 77 language are typed constants.)
-
-For example, @samp{1} is always type @code{INTEGER(KIND=1)} in GNU
-Fortran (called default INTEGER in Fortran 90),
-@samp{9.435784839284958} is always type @code{REAL(KIND=1)} (even if the
-additional precision specified is lost, and even when used in a
-@code{REAL(KIND=2)} context), @samp{1E0} is always type @code{REAL(KIND=2)},
-and @samp{1D0} is always type @code{REAL(KIND=2)}.
-
-@node Integer Type
-@subsection Integer Type
-
-(Corresponds to Section 4.3 of ANSI X3.9-1978 FORTRAN 77.)
-
-An integer constant also may have one of the following forms:
-
-@smallexample
-B'@var{binary-digits}'
-O'@var{octal-digits}'
-Z'@var{hexadecimal-digits}'
-X'@var{hexadecimal-digits}'
-@end smallexample
-
-@noindent
-@var{binary-digits}, @var{octal-digits}, and @var{hexadecimal-digits}
-are nonempty strings of characters in the set @samp{01}, @samp{01234567},
-and @samp{0123456789ABCDEFabcdef}, respectively.
-(The value for @samp{A} (and @samp{a}) is 10, for @samp{B} and @samp{b}
-is 11, and so on.)
-
-@node Character Type
-@subsection Character Type
-
-(Corresponds to Section 4.8 of ANSI X3.9-1978 FORTRAN 77.)
-
-@cindex double quoted character constants
-A character constant may be delimited by a pair of double quotes
-(@samp{"}) instead of apostrophes.
-In this case, an apostrophe within the constant represents
-a single apostrophe, while a double quote is represented in
-the source text of the constant by two consecutive double
-quotes with no intervening spaces.
-
-@cindex zero-length CHARACTER
-@cindex null CHARACTER strings
-@cindex empty CHARACTER strings
-@cindex strings, empty
-@cindex CHARACTER, null
-A character constant may be empty (have a length of zero).
-
-A character constant may include a substring specification,
-The value of such a constant is the value of the substring---for
-example, the value of @samp{'hello'(3:5)} is the same
-as the value of @samp{'llo'}.
-
-@node Expressions
-@section Expressions
-
-(The following information augments or overrides the information in
-Chapter 6 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 6 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* %LOC()::
-@end menu
-
-@node %LOC()
-@subsection The @code{%LOC()} Construct
-@cindex %LOC() construct
-
-@example
-%LOC(@var{arg})
-@end example
-
-The @code{%LOC()} construct is an expression
-that yields the value of the location of its argument,
-@var{arg}, in memory.
-The size of the type of the expression depends on the system---typically,
-it is equivalent to either @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=2)},
-though it is actually type @code{INTEGER(KIND=7)}.
-
-The argument to @code{%LOC()} must be suitable as the
-left-hand side of an assignment statement.
-That is, it may not be a general expression involving
-operators such as addition, subtraction, and so on,
-nor may it be a constant.
-
-Use of @code{%LOC()} is recommended only for code that
-is accessing facilities outside of GNU Fortran, such as
-operating system or windowing facilities.
-It is best to constrain such uses to isolated portions of
-a program---portions that deal specifically and exclusively
-with low-level, system-dependent facilities.
-Such portions might well provide a portable interface for
-use by the program as a whole, but are themselves not
-portable, and should be thoroughly tested each time they
-are rebuilt using a new compiler or version of a compiler.
-
-Do not depend on @code{%LOC()} returning a pointer that
-can be safely used to @emph{define} (change) the argument.
-While this might work in some circumstances, it is hard
-to predict whether it will continue to work when a program
-(that works using this unsafe behavior)
-is recompiled using different command-line options or
-a different version of @command{g77}.
-
-Generally, @code{%LOC()} is safe when used as an argument
-to a procedure that makes use of the value of the corresponding
-dummy argument only during its activation, and only when
-such use is restricted to referencing (reading) the value
-of the argument to @code{%LOC()}.
-
-@emph{Implementation Note:} Currently, @command{g77} passes
-arguments (those not passed using a construct such as @code{%VAL()})
-by reference or descriptor, depending on the type of
-the actual argument.
-Thus, given @samp{INTEGER I}, @samp{CALL FOO(I)} would
-seem to mean the same thing as @samp{CALL FOO(%VAL(%LOC(I)))}, and
-in fact might compile to identical code.
-
-However, @samp{CALL FOO(%VAL(%LOC(I)))} emphatically means
-``pass, by value, the address of @samp{I} in memory''.
-While @samp{CALL FOO(I)} might use that same approach in a
-particular version of @command{g77}, another version or compiler
-might choose a different implementation, such as copy-in/copy-out,
-to effect the desired behavior---and which will therefore not
-necessarily compile to the same code as would
-@samp{CALL FOO(%VAL(%LOC(I)))}
-using the same version or compiler.
-
-@xref{Debugging and Interfacing}, for detailed information on
-how this particular version of @command{g77} implements various
-constructs.
-
-@node Specification Statements
-@section Specification Statements
-
-(The following information augments or overrides the information in
-Chapter 8 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 8 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* NAMELIST::
-* DOUBLE COMPLEX::
-@end menu
-
-@node NAMELIST
-@subsection @code{NAMELIST} Statement
-@cindex NAMELIST statement
-@cindex statements, NAMELIST
-
-The @code{NAMELIST} statement, and related I/O constructs, are
-supported by the GNU Fortran language in essentially the same
-way as they are by @command{f2c}.
-
-This follows Fortran 90 with the restriction that on @code{NAMELIST}
-input, subscripts must have the form
-@smallexample
-@var{subscript} [ @code{:} @var{subscript} [ @code{:} @var{stride}]]
-@end smallexample
-i.e.@:
-@smallexample
-&xx x(1:3,8:10:2)=1,2,3,4,5,6/
-@end smallexample
-is allowed, but not, say,
-@smallexample
-&xx x(:3,8::2)=1,2,3,4,5,6/
-@end smallexample
-
-As an extension of the Fortran 90 form, @code{$} and @code{$END} may be
-used in place of @code{&} and @code{/} in @code{NAMELIST} input, so that
-@smallexample
-$&xx x(1:3,8:10:2)=1,2,3,4,5,6 $end
-@end smallexample
-could be used instead of the example above.
-
-@node DOUBLE COMPLEX
-@subsection @code{DOUBLE COMPLEX} Statement
-@cindex DOUBLE COMPLEX
-
-@code{DOUBLE COMPLEX} is a type-statement (and type) that
-specifies the type @code{COMPLEX(KIND=2)} in GNU Fortran.
-
-@node Control Statements
-@section Control Statements
-
-(The following information augments or overrides the information in
-Chapter 11 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 11 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* DO WHILE::
-* END DO::
-* Construct Names::
-* CYCLE and EXIT::
-@end menu
-
-@node DO WHILE
-@subsection DO WHILE
-@cindex DO WHILE
-@cindex DO
-@cindex MIL-STD 1753
-
-The @code{DO WHILE} statement, a feature of both the MIL-STD 1753 and
-Fortran 90 standards, is provided by the GNU Fortran language.
-The Fortran 90 ``do forever'' statement comprising just @code{DO} is
-also supported.
-
-@node END DO
-@subsection END DO
-@cindex END DO
-@cindex MIL-STD 1753
-
-The @code{END DO} statement is provided by the GNU Fortran language.
-
-This statement is used in one of two ways:
-
-@itemize @bullet
-@item
-The Fortran 90 meaning, in which it specifies the termination
-point of a single @code{DO} loop started with a @code{DO} statement
-that specifies no termination label.
-
-@item
-The MIL-STD 1753 meaning, in which it specifies the termination
-point of one or more @code{DO} loops, all of which start with a
-@code{DO} statement that specify the label defined for the
-@code{END DO} statement.
-
-This kind of @code{END DO} statement is merely a synonym for
-@code{CONTINUE}, except it is permitted only when the statement
-is labeled and a target of one or more labeled @code{DO} loops.
-
-It is expected that this use of @code{END DO} will be removed from
-the GNU Fortran language in the future, though it is likely that
-it will long be supported by @command{g77} as a dialect form.
-@end itemize
-
-@node Construct Names
-@subsection Construct Names
-@cindex construct names
-
-The GNU Fortran language supports construct names as defined
-by the Fortran 90 standard.
-These names are local to the program unit and are defined
-as follows:
-
-@smallexample
-@var{construct-name}: @var{block-statement}
-@end smallexample
-
-@noindent
-Here, @var{construct-name} is the construct name itself;
-its definition is connoted by the single colon (@samp{:}); and
-@var{block-statement} is an @code{IF}, @code{DO},
-or @code{SELECT CASE} statement that begins a block.
-
-A block that is given a construct name must also specify the
-same construct name in its termination statement:
-
-@example
-END @var{block} @var{construct-name}
-@end example
-
-@noindent
-Here, @var{block} must be @code{IF}, @code{DO}, or @code{SELECT},
-as appropriate.
-
-@node CYCLE and EXIT
-@subsection The @code{CYCLE} and @code{EXIT} Statements
-
-@cindex CYCLE statement
-@cindex EXIT statement
-@cindex statements, CYCLE
-@cindex statements, EXIT
-The @code{CYCLE} and @code{EXIT} statements specify that
-the remaining statements in the current iteration of a
-particular active (enclosing) @code{DO} loop are to be skipped.
-
-@code{CYCLE} specifies that these statements are skipped,
-but the @code{END DO} statement that marks the end of the
-@code{DO} loop be executed---that is, the next iteration,
-if any, is to be started.
-If the statement marking the end of the @code{DO} loop is
-not @code{END DO}---in other words, if the loop is not
-a block @code{DO}---the @code{CYCLE} statement does not
-execute that statement, but does start the next iteration (if any).
-
-@code{EXIT} specifies that the loop specified by the
-@code{DO} construct is terminated.
-
-The @code{DO} loop affected by @code{CYCLE} and @code{EXIT}
-is the innermost enclosing @code{DO} loop when the following
-forms are used:
-
-@example
-CYCLE
-EXIT
-@end example
-
-Otherwise, the following forms specify the construct name
-of the pertinent @code{DO} loop:
-
-@example
-CYCLE @var{construct-name}
-EXIT @var{construct-name}
-@end example
-
-@code{CYCLE} and @code{EXIT} can be viewed as glorified @code{GO TO}
-statements.
-However, they cannot be easily thought of as @code{GO TO} statements
-in obscure cases involving FORTRAN 77 loops.
-For example:
-
-@smallexample
-      DO 10 I = 1, 5
-      DO 10 J = 1, 5
-         IF (J .EQ. 5) EXIT
-      DO 10 K = 1, 5
-         IF (K .EQ. 3) CYCLE
-10    PRINT *, 'I=', I, ' J=', J, ' K=', K
-20    CONTINUE
-@end smallexample
-
-@noindent
-In particular, neither the @code{EXIT} nor @code{CYCLE} statements
-above are equivalent to a @code{GO TO} statement to either label
-@samp{10} or @samp{20}.
-
-To understand the effect of @code{CYCLE} and @code{EXIT} in the
-above fragment, it is helpful to first translate it to its equivalent
-using only block @code{DO} loops:
-
-@smallexample
-      DO I = 1, 5
-         DO J = 1, 5
-            IF (J .EQ. 5) EXIT
-            DO K = 1, 5
-               IF (K .EQ. 3) CYCLE
-10             PRINT *, 'I=', I, ' J=', J, ' K=', K
-            END DO
-         END DO
-      END DO
-20    CONTINUE
-@end smallexample
-
-Adding new labels allows translation of @code{CYCLE} and @code{EXIT}
-to @code{GO TO} so they may be more easily understood by programmers
-accustomed to FORTRAN coding:
-
-@smallexample
-      DO I = 1, 5
-         DO J = 1, 5
-            IF (J .EQ. 5) GOTO 18
-            DO K = 1, 5
-               IF (K .EQ. 3) GO TO 12
-10             PRINT *, 'I=', I, ' J=', J, ' K=', K
-12          END DO
-         END DO
-18    END DO
-20    CONTINUE
-@end smallexample
-
-@noindent
-Thus, the @code{CYCLE} statement in the innermost loop skips over
-the @code{PRINT} statement as it begins the next iteration of the
-loop, while the @code{EXIT} statement in the middle loop ends that
-loop but @emph{not} the outermost loop.
-
-@node Functions and Subroutines
-@section Functions and Subroutines
-
-(The following information augments or overrides the information in
-Chapter 15 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 15 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* %VAL()::
-* %REF()::
-* %DESCR()::
-* Generics and Specifics::
-* REAL() and AIMAG() of Complex::
-* CMPLX() of DOUBLE PRECISION::
-* MIL-STD 1753::
-* f77/f2c Intrinsics::
-* Table of Intrinsic Functions::
-@end menu
-
-@node %VAL()
-@subsection The @code{%VAL()} Construct
-@cindex %VAL() construct
-
-@example
-%VAL(@var{arg})
-@end example
-
-The @code{%VAL()} construct specifies that an argument,
-@var{arg}, is to be passed by value, instead of by reference
-or descriptor.
-
-@code{%VAL()} is restricted to actual arguments in
-invocations of external procedures.
-
-Use of @code{%VAL()} is recommended only for code that
-is accessing facilities outside of GNU Fortran, such as
-operating system or windowing facilities.
-It is best to constrain such uses to isolated portions of
-a program---portions the deal specifically and exclusively
-with low-level, system-dependent facilities.
-Such portions might well provide a portable interface for
-use by the program as a whole, but are themselves not
-portable, and should be thoroughly tested each time they
-are rebuilt using a new compiler or version of a compiler.
-
-@emph{Implementation Note:} Currently, @command{g77} passes
-all arguments either by reference or by descriptor.
-
-Thus, use of @code{%VAL()} tends to be restricted to cases
-where the called procedure is written in a language other
-than Fortran that supports call-by-value semantics.
-(C is an example of such a language.)
-
-@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)},
-for detailed information on
-how this particular version of @command{g77} passes arguments
-to procedures.
-
-@node %REF()
-@subsection The @code{%REF()} Construct
-@cindex %REF() construct
-
-@example
-%REF(@var{arg})
-@end example
-
-The @code{%REF()} construct specifies that an argument,
-@var{arg}, is to be passed by reference, instead of by
-value or descriptor.
-
-@code{%REF()} is restricted to actual arguments in
-invocations of external procedures.
-
-Use of @code{%REF()} is recommended only for code that
-is accessing facilities outside of GNU Fortran, such as
-operating system or windowing facilities.
-It is best to constrain such uses to isolated portions of
-a program---portions the deal specifically and exclusively
-with low-level, system-dependent facilities.
-Such portions might well provide a portable interface for
-use by the program as a whole, but are themselves not
-portable, and should be thoroughly tested each time they
-are rebuilt using a new compiler or version of a compiler.
-
-Do not depend on @code{%REF()} supplying a pointer to the
-procedure being invoked.
-While that is a likely implementation choice, other
-implementation choices are available that preserve Fortran
-pass-by-reference semantics without passing a pointer to
-the argument, @var{arg}.
-(For example, a copy-in/copy-out implementation.)
-
-@emph{Implementation Note:} Currently, @command{g77} passes
-all arguments
-(other than variables and arrays of type @code{CHARACTER})
-by reference.
-Future versions of, or dialects supported by, @command{g77} might
-not pass @code{CHARACTER} functions by reference.
-
-Thus, use of @code{%REF()} tends to be restricted to cases
-where @var{arg} is type @code{CHARACTER} but the called
-procedure accesses it via a means other than the method
-used for Fortran @code{CHARACTER} arguments.
-
-@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)}, for detailed information on
-how this particular version of @command{g77} passes arguments
-to procedures.
-
-@node %DESCR()
-@subsection The @code{%DESCR()} Construct
-@cindex %DESCR() construct
-
-@example
-%DESCR(@var{arg})
-@end example
-
-The @code{%DESCR()} construct specifies that an argument,
-@var{arg}, is to be passed by descriptor, instead of by
-value or reference.
-
-@code{%DESCR()} is restricted to actual arguments in
-invocations of external procedures.
-
-Use of @code{%DESCR()} is recommended only for code that
-is accessing facilities outside of GNU Fortran, such as
-operating system or windowing facilities.
-It is best to constrain such uses to isolated portions of
-a program---portions the deal specifically and exclusively
-with low-level, system-dependent facilities.
-Such portions might well provide a portable interface for
-use by the program as a whole, but are themselves not
-portable, and should be thoroughly tested each time they
-are rebuilt using a new compiler or version of a compiler.
-
-Do not depend on @code{%DESCR()} supplying a pointer
-and/or a length passed by value
-to the procedure being invoked.
-While that is a likely implementation choice, other
-implementation choices are available that preserve the
-pass-by-reference semantics without passing a pointer to
-the argument, @var{arg}.
-(For example, a copy-in/copy-out implementation.)
-And, future versions of @command{g77} might change the
-way descriptors are implemented, such as passing a
-single argument pointing to a record containing the
-pointer/length information instead of passing that same
-information via two arguments as it currently does.
-
-@emph{Implementation Note:} Currently, @command{g77} passes
-all variables and arrays of type @code{CHARACTER}
-by descriptor.
-Future versions of, or dialects supported by, @command{g77} might
-pass @code{CHARACTER} functions by descriptor as well.
-
-Thus, use of @code{%DESCR()} tends to be restricted to cases
-where @var{arg} is not type @code{CHARACTER} but the called
-procedure accesses it via a means similar to the method
-used for Fortran @code{CHARACTER} arguments.
-
-@xref{Procedures,,Procedures (SUBROUTINE and FUNCTION)}, for detailed information on
-how this particular version of @command{g77} passes arguments
-to procedures.
-
-@node Generics and Specifics
-@subsection Generics and Specifics
-@cindex generic intrinsics
-@cindex intrinsics, generic
-
-The ANSI FORTRAN 77 language defines generic and specific
-intrinsics.
-In short, the distinctions are:
-
-@itemize @bullet
-@item
-@emph{Specific} intrinsics have
-specific types for their arguments and a specific return
-type.
-
-@item
-@emph{Generic} intrinsics are treated,
-on a case-by-case basis in the program's source code,
-as one of several possible specific intrinsics.
-
-Typically, a generic intrinsic has a return type that
-is determined by the type of one or more of its arguments.
-@end itemize
-
-The GNU Fortran language generalizes these concepts somewhat,
-especially by providing intrinsic subroutines and generic
-intrinsics that are treated as either a specific intrinsic subroutine
-or a specific intrinsic function (e.g. @code{SECOND}).
-
-However, GNU Fortran avoids generalizing this concept to
-the point where existing code would be accepted as meaning
-something possibly different than what was intended.
-
-For example, @code{ABS} is a generic intrinsic, so all working
-code written using @code{ABS} of an @code{INTEGER} argument
-expects an @code{INTEGER} return value.
-Similarly, all such code expects that @code{ABS} of an @code{INTEGER*2}
-argument returns an @code{INTEGER*2} return value.
-
-Yet, @code{IABS} is a @emph{specific} intrinsic that accepts only
-an @code{INTEGER(KIND=1)} argument.
-Code that passes something other than an @code{INTEGER(KIND=1)}
-argument to @code{IABS} is not valid GNU Fortran code, because
-it is not clear what the author intended.
-
-For example, if @samp{J} is @code{INTEGER(KIND=6)}, @samp{IABS(J)}
-is not defined by the GNU Fortran language, because the programmer
-might have used that construct to mean any of the following, subtly
-different, things:
-
-@itemize @bullet
-@item
-Convert @samp{J} to @code{INTEGER(KIND=1)} first
-(as if @samp{IABS(INT(J))} had been written).
-
-@item
-Convert the result of the intrinsic to @code{INTEGER(KIND=1)}
-(as if @samp{INT(ABS(J))} had been written).
-
-@item
-No conversion (as if @samp{ABS(J)} had been written).
-@end itemize
-
-The distinctions matter especially when types and values wider than
-@code{INTEGER(KIND=1)} (such as @code{INTEGER(KIND=2)}), or when
-operations performing more ``arithmetic'' than absolute-value, are involved.
-
-The following sample program is not a valid GNU Fortran program, but
-might be accepted by other compilers.
-If so, the output is likely to be revealing in terms of how a given
-compiler treats intrinsics (that normally are specific) when they
-are given arguments that do not conform to their stated requirements:
-
-@cindex JCB002 program
-@smallexample
-      PROGRAM JCB002
-C Version 1:
-C Modified 1999-02-15 (Burley) to delete my email address.
-C Modified 1997-05-21 (Burley) to accommodate compilers that implement
-C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2.
-C
-C Version 0:
-C Written by James Craig Burley 1997-02-20.
-C
-C Purpose:
-C Determine how compilers handle non-standard IDIM
-C on INTEGER*2 operands, which presumably can be
-C extrapolated into understanding how the compiler
-C generally treats specific intrinsics that are passed
-C arguments not of the correct types.
-C
-C If your compiler implements INTEGER*2 and INTEGER
-C as the same type, change all INTEGER*2 below to
-C INTEGER*1.
-C
-      INTEGER*2 I0, I4
-      INTEGER I1, I2, I3
-      INTEGER*2 ISMALL, ILARGE
-      INTEGER*2 ITOOLG, ITWO
-      INTEGER*2 ITMP
-      LOGICAL L2, L3, L4
-C
-C Find smallest INTEGER*2 number.
-C
-      ISMALL=0
- 10   I0 = ISMALL-1
-      IF ((I0 .GE. ISMALL) .OR. (I0+1 .NE. ISMALL)) GOTO 20
-      ISMALL = I0
-      GOTO 10
- 20   CONTINUE
-C
-C Find largest INTEGER*2 number.
-C
-      ILARGE=0
- 30   I0 = ILARGE+1
-      IF ((I0 .LE. ILARGE) .OR. (I0-1 .NE. ILARGE)) GOTO 40
-      ILARGE = I0
-      GOTO 30
- 40   CONTINUE
-C
-C Multiplying by two adds stress to the situation.
-C
-      ITWO = 2
-C
-C Need a number that, added to -2, is too wide to fit in I*2.
-C
-      ITOOLG = ISMALL
-C
-C Use IDIM the straightforward way.
-C
-      I1 = IDIM (ILARGE, ISMALL) * ITWO + ITOOLG
-C
-C Calculate result for first interpretation.
-C
-      I2 = (INT (ILARGE) - INT (ISMALL)) * ITWO + ITOOLG
-C
-C Calculate result for second interpretation.
-C
-      ITMP = ILARGE - ISMALL
-      I3 = (INT (ITMP)) * ITWO + ITOOLG
-C
-C Calculate result for third interpretation.
-C
-      I4 = (ILARGE - ISMALL) * ITWO + ITOOLG
-C
-C Print results.
-C
-      PRINT *, 'ILARGE=', ILARGE
-      PRINT *, 'ITWO=', ITWO
-      PRINT *, 'ITOOLG=', ITOOLG
-      PRINT *, 'ISMALL=', ISMALL
-      PRINT *, 'I1=', I1
-      PRINT *, 'I2=', I2
-      PRINT *, 'I3=', I3
-      PRINT *, 'I4=', I4
-      PRINT *
-      L2 = (I1 .EQ. I2)
-      L3 = (I1 .EQ. I3)
-      L4 = (I1 .EQ. I4)
-      IF (L2 .AND. .NOT.L3 .AND. .NOT.L4) THEN
-         PRINT *, 'Interp 1: IDIM(I*2,I*2) => IDIM(INT(I*2),INT(I*2))'
-         STOP
-      END IF
-      IF (L3 .AND. .NOT.L2 .AND. .NOT.L4) THEN
-         PRINT *, 'Interp 2: IDIM(I*2,I*2) => INT(DIM(I*2,I*2))'
-         STOP
-      END IF
-      IF (L4 .AND. .NOT.L2 .AND. .NOT.L3) THEN
-         PRINT *, 'Interp 3: IDIM(I*2,I*2) => DIM(I*2,I*2)'
-         STOP
-      END IF
-      PRINT *, 'Results need careful analysis.'
-      END
-@end smallexample
-
-No future version of the GNU Fortran language
-will likely permit specific intrinsic invocations with wrong-typed
-arguments (such as @code{IDIM} in the above example), since
-it has been determined that disagreements exist among
-many production compilers on the interpretation of
-such invocations.
-These disagreements strongly suggest that Fortran programmers,
-and certainly existing Fortran programs, disagree about the
-meaning of such invocations.
-
-The first version of @code{JCB002} didn't accommodate some compilers'
-treatment of @samp{INT(I1-I2)} where @samp{I1} and @samp{I2} are
-@code{INTEGER*2}.
-In such a case, these compilers apparently convert both
-operands to @code{INTEGER*4} and then do an @code{INTEGER*4} subtraction,
-instead of doing an @code{INTEGER*2} subtraction on the
-original values in @samp{I1} and @samp{I2}.
-
-However, the results of the careful analyses done on the outputs
-of programs compiled by these various compilers show that they
-all implement either @samp{Interp 1} or @samp{Interp 2} above.
-
-Specifically, it is believed that the new version of @code{JCB002}
-above will confirm that:
-
-@itemize @bullet
-@item
-Digital Semiconductor (``DEC'') Alpha OSF/1, HP-UX 10.0.1, AIX 3.2.5
-@command{f77} compilers all implement @samp{Interp 1}.
-
-@item
-IRIX 5.3 @command{f77} compiler implements @samp{Interp 2}.
-
-@item
-Solaris 2.5, SunOS 4.1.3, DECstation ULTRIX 4.3,
-and IRIX 6.1 @command{f77} compilers all implement @samp{Interp 3}.
-@end itemize
-
-If you get different results than the above for the stated
-compilers, or have results for other compilers that might be
-worth adding to the above list, please let us know the details
-(compiler product, version, machine, results, and so on).
-
-@node REAL() and AIMAG() of Complex
-@subsection @code{REAL()} and @code{AIMAG()} of Complex
-@cindex @code{Real} intrinsic
-@cindex intrinsics, @code{Real}
-@cindex @code{AImag} intrinsic
-@cindex intrinsics, @code{AImag}
-
-The GNU Fortran language disallows @code{REAL(@var{expr})}
-and @code{AIMAG(@var{expr})},
-where @var{expr} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
-except when they are used in the following way:
-
-@example
-REAL(REAL(@var{expr}))
-REAL(AIMAG(@var{expr}))
-@end example
-
-@noindent
-The above forms explicitly specify that the desired effect
-is to convert the real or imaginary part of @var{expr}, which might
-be some @code{REAL} type other than @code{REAL(KIND=1)},
-to type @code{REAL(KIND=1)},
-and have that serve as the value of the expression.
-
-The GNU Fortran language offers clearly named intrinsics to extract the
-real and imaginary parts of a complex entity without any
-conversion:
-
-@example
-REALPART(@var{expr})
-IMAGPART(@var{expr})
-@end example
-
-To express the above using typical extended FORTRAN 77,
-use the following constructs
-(when @var{expr} is @code{COMPLEX(KIND=2)}):
-
-@example
-DBLE(@var{expr})
-DIMAG(@var{expr})
-@end example
-
-The FORTRAN 77 language offers no way
-to explicitly specify the real and imaginary parts of a complex expression of
-arbitrary type, apparently as a result of requiring support for
-only one @code{COMPLEX} type (@code{COMPLEX(KIND=1)}).
-The concepts of converting an expression to type @code{REAL(KIND=1)} and
-of extracting the real part of a complex expression were
-thus ``smooshed'' by FORTRAN 77 into a single intrinsic, since
-they happened to have the exact same effect in that language
-(due to having only one @code{COMPLEX} type).
-
-@emph{Note:} When @option{-ff90} is in effect,
-@command{g77} treats @samp{REAL(@var{expr})}, where @var{expr} is of
-type @code{COMPLEX}, as @samp{REALPART(@var{expr})},
-whereas with @samp{-fugly-complex -fno-f90} in effect, it is
-treated as @samp{REAL(REALPART(@var{expr}))}.
-
-@xref{Ugly Complex Part Extraction}, for more information.
-
-@node CMPLX() of DOUBLE PRECISION
-@subsection @code{CMPLX()} of @code{DOUBLE PRECISION}
-@cindex @code{Cmplx} intrinsic
-@cindex intrinsics, @code{Cmplx}
-
-In accordance with Fortran 90 and at least some (perhaps all)
-other compilers, the GNU Fortran language defines @code{CMPLX()}
-as always returning a result that is type @code{COMPLEX(KIND=1)}.
-
-This means @samp{CMPLX(D1,D2)}, where @samp{D1} and @samp{D2}
-are @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}), is treated as:
-
-@example
-CMPLX(SNGL(D1), SNGL(D2))
-@end example
-
-(It was necessary for Fortran 90 to specify this behavior
-for @code{DOUBLE PRECISION} arguments, since that is
-the behavior mandated by FORTRAN 77.)
-
-The GNU Fortran language also provides the @code{DCMPLX()} intrinsic,
-which is provided by some FORTRAN 77 compilers to construct
-a @code{DOUBLE COMPLEX} entity from of @code{DOUBLE PRECISION}
-operands.
-However, this solution does not scale well when more @code{COMPLEX} types
-(having various precisions and ranges) are offered by Fortran implementations.
-
-Fortran 90 extends the @code{CMPLX()} intrinsic by adding
-an extra argument used to specify the desired kind of complex
-result.
-However, this solution is somewhat awkward to use, and
-@command{g77} currently does not support it.
-
-The GNU Fortran language provides a simple way to build a complex
-value out of two numbers, with the precise type of the value
-determined by the types of the two numbers (via the usual
-type-promotion mechanism):
-
-@example
-COMPLEX(@var{real}, @var{imag})
-@end example
-
-When @var{real} and @var{imag} are the same @code{REAL} types, @code{COMPLEX()}
-performs no conversion other than to put them together to form a
-complex result of the same (complex version of real) type.
-
-@xref{Complex Intrinsic}, for more information.
-
-@node MIL-STD 1753
-@subsection MIL-STD 1753 Support
-@cindex MIL-STD 1753
-
-The GNU Fortran language includes the MIL-STD 1753 intrinsics
-@code{BTEST}, @code{IAND}, @code{IBCLR}, @code{IBITS},
-@code{IBSET}, @code{IEOR}, @code{IOR}, @code{ISHFT},
-@code{ISHFTC}, @code{MVBITS}, and @code{NOT}.
-
-@node f77/f2c Intrinsics
-@subsection @command{f77}/@command{f2c} Intrinsics
-
-The bit-manipulation intrinsics supported by traditional
-@command{f77} and by @command{f2c} are available in the GNU Fortran language.
-These include @code{AND}, @code{LSHIFT}, @code{OR}, @code{RSHIFT},
-and @code{XOR}.
-
-Also supported are the intrinsics @code{CDABS},
-@code{CDCOS}, @code{CDEXP}, @code{CDLOG}, @code{CDSIN},
-@code{CDSQRT}, @code{DCMPLX}, @code{DCONJG}, @code{DFLOAT},
-@code{DIMAG}, @code{DREAL}, and @code{IMAG},
-@code{ZABS}, @code{ZCOS}, @code{ZEXP}, @code{ZLOG}, @code{ZSIN},
-and @code{ZSQRT}.
-
-@node Table of Intrinsic Functions
-@subsection Table of Intrinsic Functions
-@cindex intrinsics, table of
-@cindex table of intrinsics
-
-(Corresponds to Section 15.10 of ANSI X3.9-1978 FORTRAN 77.)
-
-The GNU Fortran language adds various functions, subroutines, types,
-and arguments to the set of intrinsic functions in ANSI FORTRAN 77.
-The complete set of intrinsics supported by the GNU Fortran language
-is described below.
-
-Note that a name is not treated as that of an intrinsic if it is
-specified in an @code{EXTERNAL} statement in the same program unit;
-if a command-line option is used to disable the groups to which
-the intrinsic belongs; or if the intrinsic is not named in an
-@code{INTRINSIC} statement and a command-line option is used to
-hide the groups to which the intrinsic belongs.
-
-So, it is recommended that any reference in a program unit to
-an intrinsic procedure that is not a standard FORTRAN 77
-intrinsic be accompanied by an appropriate @code{INTRINSIC}
-statement in that program unit.
-This sort of defensive programming makes it more
-likely that an implementation will issue a diagnostic rather
-than generate incorrect code for such a reference.
-
-The terminology used below is based on that of the Fortran 90
-standard, so that the text may be more concise and accurate:
-
-@itemize @bullet
-@item
-@code{OPTIONAL} means the argument may be omitted.
-
-@item
-@samp{A-1, A-2, @dots{}, A-n} means more than one argument
-(generally named @samp{A}) may be specified.
-
-@item
-@samp{scalar} means the argument must not be an array (must
-be a variable or array element, or perhaps a constant if expressions
-are permitted).
-
-@item
-@samp{DIMENSION(4)} means the argument must be an array having 4 elements.
-
-@item
-@code{INTENT(IN)} means the argument must be an expression
-(such as a constant or a variable that is defined upon invocation
-of the intrinsic).
-
-@item
-@code{INTENT(OUT)} means the argument must be definable by the
-invocation of the intrinsic (that is, must not be a constant nor
-an expression involving operators other than array reference and
-substring reference).
-
-@item
-@code{INTENT(INOUT)} means the argument must be defined prior to,
-and definable by, invocation of the intrinsic (a combination of
-the requirements of @code{INTENT(IN)} and @code{INTENT(OUT)}.
-
-@item
-@xref{Kind Notation}, for an explanation of @code{KIND}.
-@end itemize
-
-@ifinfo
-(Note that the empty lines appearing in the menu below
-are not intentional---they result from a bug in the
-GNU @command{makeinfo} program@dots{}a program that, if it
-did not exist, would leave this document in far worse shape!)
-@end ifinfo
-
-@c The actual documentation for intrinsics comes from
-@c intdoc.texi, which in turn is automatically generated
-@c from the internal g77 tables in intrin.def _and_ the
-@c largely hand-written text in intdoc.h.  So, if you want
-@c to change or add to existing documentation on intrinsics,
-@c you probably want to edit intdoc.h.
-@c
-@set familyF77
-@set familyGNU
-@set familyASC
-@set familyMIL
-@set familyF90
-@clear familyVXT
-@clear familyFVZ
-@set familyF2C
-@set familyF2U
-@clear familyBADU77
-@include intdoc.texi
-
-@node Scope and Classes of Names
-@section Scope and Classes of Symbolic Names
-@cindex symbol names, scope and classes
-@cindex scope
-
-(The following information augments or overrides the information in
-Chapter 18 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran
-language.
-Chapter 18 of that document otherwise serves as the basis
-for the relevant aspects of GNU Fortran.)
-
-@menu
-* Underscores in Symbol Names::
-@end menu
-
-@node Underscores in Symbol Names
-@subsection Underscores in Symbol Names
-@cindex underscore
-
-Underscores (@samp{_}) are accepted in symbol names after the first
-character (which must be a letter).
-
-@node I/O
-@section I/O
-
-@cindex dollar sign
-A dollar sign at the end of an output format specification suppresses
-the newline at the end of the output.
-
-@cindex <> edit descriptor
-@cindex edit descriptor, <>
-Edit descriptors in @code{FORMAT} statements may contain compile-time
-@code{INTEGER} constant expressions in angle brackets, such as
-@smallexample
-10    FORMAT (I<WIDTH>)
-@end smallexample
-
-The @code{OPEN} specifier @code{NAME=} is equivalent to @code{FILE=}.
-
-These Fortran 90 features are supported:
-@itemize @bullet
-@item
-@cindex FORMAT descriptors
-@cindex Z edit descriptor
-@cindex edit descriptor, Z
-@cindex O edit descriptor
-@cindex edit descriptor, O
-The @code{O} and @code{Z} edit descriptors are supported for I/O of
-integers in octal and hexadecimal formats, respectively.
-@item
-The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if
-@code{STATUS='SCRATCH'} is supplied.  The @code{STATUS='REPLACE'}
-specifier is supported.
-@end itemize
-
-@node Fortran 90 Features
-@section Fortran 90 Features
-@cindex Fortran 90
-@cindex extensions, from Fortran 90
-
-For convenience this section collects a list (probably incomplete) of
-the Fortran 90 features supported by the GNU Fortran language, even if
-they are documented elsewhere.
-@xref{Characters Lines Sequence,,@asis{Characters, Lines, and Execution Sequence}},
-for information on additional fixed source form lexical issues.
-@cindex @option{-ffree-form}
-Further, the free source form is supported through the
-@option{-ffree-form} option.
-@cindex @option{-ff90}
-Other Fortran 90 features can be turned on by the @option{-ff90} option;
-see @ref{Fortran 90}.
-For information on the Fortran 90 intrinsics available,
-see @ref{Table of Intrinsic Functions}.
-
-@table @asis
-@item Automatic arrays in procedures
-@item Character assignments
-@cindex character assignments
-In character assignments, the variable being assigned may occur on the
-right hand side of the assignment.
-@item Character strings
-@cindex double quoted character constants
-Strings may have zero length and substrings of character constants are
-permitted.  Character constants may be enclosed in double quotes
-(@code{"}) as well as single quotes.  @xref{Character Type}.
-@item Construct names
-(Symbolic tags on blocks.)  @xref{Construct Names}.
-@item @code{CYCLE} and @code{EXIT}
-@xref{CYCLE and EXIT,,The @code{CYCLE} and @code{EXIT} Statements}.
-@item @code{DOUBLE COMPLEX}
-@xref{DOUBLE COMPLEX,,@code{DOUBLE COMPLEX} Statement}.
-@item @code{DO WHILE}
-@xref{DO WHILE}.
-@item @code{END} decoration
-@xref{Statements}.
-@item @code{END DO}
-@xref{END DO}.
-@item @code{KIND}
-@item @code{IMPLICIT NONE}
-@item @code{INCLUDE} statements
-@xref{INCLUDE}.
-@item List-directed and namelist I/O on internal files
-@item Binary, octal and hexadecimal constants
-These are supported more generally than required by Fortran 90.
-@xref{Integer Type}.
-@item @samp{O} and @samp{Z} edit descriptors
-@item @code{NAMELIST}
-@xref{NAMELIST}.
-@item @code{OPEN} specifiers
-@code{STATUS='REPLACE'} is supported.
-The @code{FILE=} specifier may be omitted in an @code{OPEN} statement if
-@code{STATUS='SCRATCH'} is supplied.
-@item @code{FORMAT} edit descriptors
-@cindex FORMAT descriptors
-@cindex Z edit descriptor
-@cindex edit descriptor, Z
-The @code{Z} edit descriptor is supported.
-@item Relational operators
-The operators @code{<}, @code{<=}, @code{==}, @code{/=}, @code{>} and
-@code{>=} may be used instead of @code{.LT.}, @code{.LE.}, @code{.EQ.},
-@code{.NE.}, @code{.GT.} and @code{.GE.} respectively.
-@item @code{SELECT CASE}
-Not fully implemented.
-@xref{SELECT CASE on CHARACTER Type,, @code{SELECT CASE} on @code{CHARACTER} Type}.
-@item Specification statements
-A limited subset of the Fortran 90 syntax and semantics for variable
-declarations is supported, including @code{KIND}.  @xref{Kind Notation}.
-(@code{KIND} is of limited usefulness in the absence of the
-@code{KIND}-related intrinsics, since these intrinsics permit writing
-more widely portable code.)  An example of supported @code{KIND} usage
-is:
-@smallexample
-INTEGER (KIND=1) :: FOO=1, BAR=2
-CHARACTER (LEN=3) FOO
-@end smallexample
-@code{PARAMETER} and @code{DIMENSION} attributes aren't supported.
-@end table
-
-@node Other Dialects
-@chapter Other Dialects
-
-GNU Fortran supports a variety of features that are not
-considered part of the GNU Fortran language itself, but
-are representative of various dialects of Fortran that
-@command{g77} supports in whole or in part.
-
-Any of the features listed below might be disallowed by
-@command{g77} unless some command-line option is specified.
-Currently, some of the features are accepted using the
-default invocation of @command{g77}, but that might change
-in the future.
-
-@emph{Note: This portion of the documentation definitely needs a lot
-of work!}
-
-@menu
-* Source Form::       Details of fixed-form and free-form source.
-* Trailing Comment::  Use of @samp{/*} to start a comment.
-* Debug Line::        Use of @samp{D} in column 1.
-* Dollar Signs::      Use of @samp{$} in symbolic names.
-* Case Sensitivity::  Uppercase and lowercase in source files.
-* VXT Fortran::       @dots{}versus the GNU Fortran language.
-* Fortran 90::        @dots{}versus the GNU Fortran language.
-* Pedantic Compilation::  Enforcing the standard.
-* Distensions::       Misfeatures supported by GNU Fortran.
-@end menu
-
-@node Source Form
-@section Source Form
-@cindex source file format
-@cindex source format
-@cindex file, source
-@cindex source code
-@cindex code, source
-@cindex fixed form
-@cindex free form
-
-GNU Fortran accepts programs written in either fixed form or
-free form.
-
-Fixed form
-corresponds to ANSI FORTRAN 77 (plus popular extensions, such as
-allowing tabs) and Fortran 90's fixed form.
-
-Free form corresponds to
-Fortran 90's free form (though possibly not entirely up-to-date, and
-without complaining about some things that for which Fortran 90 requires
-diagnostics, such as the spaces in the constant in @samp{R = 3 . 1}).
-
-The way a Fortran compiler views source files depends entirely on the
-implementation choices made for the compiler, since those choices
-are explicitly left to the implementation by the published Fortran
-standards.
-GNU Fortran currently tries to be somewhat like a few popular compilers
-(@command{f2c}, Digital (``DEC'') Fortran, and so on).
-
-This section describes how @command{g77} interprets source lines.
-
-@menu
-* Carriage Returns::  Carriage returns ignored.
-* Tabs::              Tabs converted to spaces.
-* Short Lines::       Short lines padded with spaces (fixed-form only).
-* Long Lines::        Long lines truncated.
-* Ampersands::        Special Continuation Lines.
-@end menu
-
-@node Carriage Returns
-@subsection Carriage Returns
-@cindex carriage returns
-
-Carriage returns (@samp{\r}) in source lines are ignored.
-This is somewhat different from @command{f2c}, which seems to treat them as
-spaces outside character/Hollerith constants, and encodes them as @samp{\r}
-inside such constants.
-
-@node Tabs
-@subsection Tabs
-@cindex tab character
-@cindex horizontal tab
-
-A source line with a @key{TAB} character anywhere in it is treated as
-entirely significant---however long it is---instead of ending in
-column 72 (for fixed-form source) or 132 (for free-form source).
-This also is different from @command{f2c}, which encodes tabs as
-@samp{\t} (the ASCII @key{TAB} character) inside character
-and Hollerith constants, but nevertheless seems to treat the column
-position as if it had been affected by the canonical tab positioning.
-
-@command{g77} effectively
-translates tabs to the appropriate number of spaces (a la the default
-for the UNIX @command{expand} command) before doing any other processing, other
-than (currently) noting whether a tab was found on a line and using this
-information to decide how to interpret the length of the line and continued
-constants.
-
-@node Short Lines
-@subsection Short Lines
-@cindex short source lines
-@cindex space, padding with
-@cindex source lines, short
-@cindex lines, short
-
-Source lines shorter than the applicable fixed-form length are treated as
-if they were padded with spaces to that length.
-(None of this is relevant to source files written in free form.)
-
-This affects only
-continued character and Hollerith constants, and is a different
-interpretation than provided by some other popular compilers
-(although a bit more consistent with the traditional punched-card
-basis of Fortran and the way the Fortran standard expressed fixed
-source form).
-
-@command{g77} might someday offer an option to warn about cases where differences
-might be seen as a result of this treatment, and perhaps an option to
-specify the alternate behavior as well.
-
-Note that this padding cannot apply to lines that are effectively of
-infinite length---such lines are specified using command-line options
-like @option{-ffixed-line-length-none}, for example.
-
-@node Long Lines
-@subsection Long Lines
-@cindex long source lines
-@cindex truncation, of long lines
-@cindex lines, long
-@cindex source lines, long
-
-Source lines longer than the applicable length are truncated to that
-length.
-Currently, @command{g77} does not warn if the truncated characters are
-not spaces, to accommodate existing code written for systems that
-treated truncated text as commentary (especially in columns 73 through 80).
-
-@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect},
-for information on the @option{-ffixed-line-length-@var{n}} option,
-which can be used to set the line length applicable to fixed-form
-source files.
-
-@node Ampersands
-@subsection Ampersand Continuation Line
-@cindex ampersand continuation line
-@cindex continuation line, ampersand
-
-A @samp{&} in column 1 of fixed-form source denotes an arbitrary-length
-continuation line, imitating the behavior of @command{f2c}.
-
-@node Trailing Comment
-@section Trailing Comment
-
-@cindex trailing comment
-@cindex comment
-@cindex characters, comment
-@cindex /*
-@cindex !
-@cindex exclamation point
-@command{g77} supports use of @samp{/*} to start a trailing
-comment.
-In the GNU Fortran language, @samp{!} is used for this purpose.
-
-@samp{/*} is not in the GNU Fortran language
-because the use of @samp{/*} in a program might
-suggest to some readers that a block, not trailing, comment is
-started (and thus ended by @samp{*/}, not end of line),
-since that is the meaning of @samp{/*} in C.
-
-Also, such readers might think they can use @samp{//} to start
-a trailing comment as an alternative to @samp{/*}, but
-@samp{//} already denotes concatenation, and such a ``comment''
-might actually result in a program that compiles without
-error (though it would likely behave incorrectly).
-
-@node Debug Line
-@section Debug Line
-@cindex debug line
-@cindex comment line, debug
-
-Use of @samp{D} or @samp{d} as the first character (column 1) of
-a source line denotes a debug line.
-
-In turn, a debug line is treated as either a comment line
-or a normal line, depending on whether debug lines are enabled.
-
-When treated as a comment line, a line beginning with @samp{D} or
-@samp{d} is treated as if it the first character was @samp{C} or @samp{c}, respectively.
-When treated as a normal line, such a line is treated as if
-the first character was @key{SPC} (space).
-
-(Currently, @command{g77} provides no means for treating debug
-lines as normal lines.)
-
-@node Dollar Signs
-@section Dollar Signs in Symbol Names
-@cindex dollar sign
-@cindex $
-
-Dollar signs (@samp{$}) are allowed in symbol names (after the first character)
-when the @option{-fdollar-ok} option is specified.
-
-@node Case Sensitivity
-@section Case Sensitivity
-@cindex case sensitivity
-@cindex source file format
-@cindex code, source
-@cindex source code
-@cindex uppercase letters
-@cindex lowercase letters
-@cindex letters, uppercase
-@cindex letters, lowercase
-
-GNU Fortran offers the programmer way too much flexibility in deciding
-how source files are to be treated vis-a-vis uppercase and lowercase
-characters.
-There are 66 useful settings that affect case sensitivity, plus 10
-settings that are nearly useless, with the remaining 116 settings
-being either redundant or useless.
-
-None of these settings have any effect on the contents of comments
-(the text after a @samp{c} or @samp{C} in Column 1, for example)
-or of character or Hollerith constants.
-Note that things like the @samp{E} in the statement
-@samp{CALL FOO(3.2E10)} and the @samp{TO} in @samp{ASSIGN 10 TO LAB}
-are considered built-in keywords, and so are affected by
-these settings.
-
-Low-level switches are identified in this section as follows:
-
-@itemize @w{}
-@item A
-Source Case Conversion:
-
-@itemize @w{}
-@item 0
-Preserve (see Note 1)
-@item 1
-Convert to Upper Case
-@item 2
-Convert to Lower Case
-@end itemize
-
-@item B
-Built-in Keyword Matching:
-
-@itemize @w{}
-@item 0
-Match Any Case (per-character basis)
-@item 1
-Match Upper Case Only
-@item 2
-Match Lower Case Only
-@item 3
-Match InitialCaps Only (see tables for spellings)
-@end itemize
-
-@item C
-Built-in Intrinsic Matching:
-
-@itemize @w{}
-@item 0
-Match Any Case (per-character basis)
-@item 1
-Match Upper Case Only
-@item 2
-Match Lower Case Only
-@item 3
-Match InitialCaps Only (see tables for spellings)
-@end itemize
-
-@item D
-User-defined Symbol Possibilities (warnings only):
-
-@itemize @w{}
-@item 0
-Allow Any Case (per-character basis)
-@item 1
-Allow Upper Case Only
-@item 2
-Allow Lower Case Only
-@item 3
-Allow InitialCaps Only (see Note 2)
-@end itemize
-@end itemize
-
-Note 1: @command{g77} eventually will support @code{NAMELIST} in a manner that is
-consistent with these source switches---in the sense that input will be
-expected to meet the same requirements as source code in terms
-of matching symbol names and keywords (for the exponent letters).
-
-Currently, however, @code{NAMELIST} is supported by @code{libg2c},
-which uppercases @code{NAMELIST} input and symbol names for matching.
-This means not only that @code{NAMELIST} output currently shows symbol
-(and keyword) names in uppercase even if lower-case source
-conversion (option A2) is selected, but that @code{NAMELIST} cannot be
-adequately supported when source case preservation (option A0)
-is selected.
-
-If A0 is selected, a warning message will be
-output for each @code{NAMELIST} statement to this effect.
-The behavior
-of the program is undefined at run time if two or more symbol names
-appear in a given @code{NAMELIST} such that the names are identical
-when converted to upper case (e.g. @samp{NAMELIST /X/ VAR, Var, var}).
-For complete and total elegance, perhaps there should be a warning
-when option A2 is selected, since the output of NAMELIST is currently
-in uppercase but will someday be lowercase (when a @code{libg77} is written),
-but that seems to be overkill for a product in beta test.
-
-Note 2: Rules for InitialCaps names are:
-
-@itemize @minus
-@item
-Must be a single uppercase letter, @strong{or}
-@item
-Must start with an uppercase letter and contain at least one
-lowercase letter.
-@end itemize
-
-So @samp{A}, @samp{Ab}, @samp{ABc}, @samp{AbC}, and @samp{Abc} are
-valid InitialCaps names, but @samp{AB}, @samp{A2}, and @samp{ABC} are
-not.
-Note that most, but not all, built-in names meet these
-requirements---the exceptions are some of the two-letter format
-specifiers, such as @code{BN} and @code{BZ}.
-
-Here are the names of the corresponding command-line options:
-
-@smallexample
-A0: -fsource-case-preserve
-A1: -fsource-case-upper
-A2: -fsource-case-lower
-
-B0: -fmatch-case-any
-B1: -fmatch-case-upper
-B2: -fmatch-case-lower
-B3: -fmatch-case-initcap
-
-C0: -fintrin-case-any
-C1: -fintrin-case-upper
-C2: -fintrin-case-lower
-C3: -fintrin-case-initcap
-
-D0: -fsymbol-case-any
-D1: -fsymbol-case-upper
-D2: -fsymbol-case-lower
-D3: -fsymbol-case-initcap
-@end smallexample
-
-Useful combinations of the above settings, along with abbreviated
-option names that set some of these combinations all at once:
-
-@smallexample
- 1: A0--  B0---  C0---  D0---    -fcase-preserve
- 2: A0--  B0---  C0---  D-1--
- 3: A0--  B0---  C0---  D--2-
- 4: A0--  B0---  C0---  D---3
- 5: A0--  B0---  C-1--  D0---
- 6: A0--  B0---  C-1--  D-1--
- 7: A0--  B0---  C-1--  D--2-
- 8: A0--  B0---  C-1--  D---3
- 9: A0--  B0---  C--2-  D0---
-10: A0--  B0---  C--2-  D-1--
-11: A0--  B0---  C--2-  D--2-
-12: A0--  B0---  C--2-  D---3
-13: A0--  B0---  C---3  D0---
-14: A0--  B0---  C---3  D-1--
-15: A0--  B0---  C---3  D--2-
-16: A0--  B0---  C---3  D---3
-17: A0--  B-1--  C0---  D0---
-18: A0--  B-1--  C0---  D-1--
-19: A0--  B-1--  C0---  D--2-
-20: A0--  B-1--  C0---  D---3
-21: A0--  B-1--  C-1--  D0---
-22: A0--  B-1--  C-1--  D-1--    -fcase-strict-upper
-23: A0--  B-1--  C-1--  D--2-
-24: A0--  B-1--  C-1--  D---3
-25: A0--  B-1--  C--2-  D0---
-26: A0--  B-1--  C--2-  D-1--
-27: A0--  B-1--  C--2-  D--2-
-28: A0--  B-1--  C--2-  D---3
-29: A0--  B-1--  C---3  D0---
-30: A0--  B-1--  C---3  D-1--
-31: A0--  B-1--  C---3  D--2-
-32: A0--  B-1--  C---3  D---3
-33: A0--  B--2-  C0---  D0---
-34: A0--  B--2-  C0---  D-1--
-35: A0--  B--2-  C0---  D--2-
-36: A0--  B--2-  C0---  D---3
-37: A0--  B--2-  C-1--  D0---
-38: A0--  B--2-  C-1--  D-1--
-39: A0--  B--2-  C-1--  D--2-
-40: A0--  B--2-  C-1--  D---3
-41: A0--  B--2-  C--2-  D0---
-42: A0--  B--2-  C--2-  D-1--
-43: A0--  B--2-  C--2-  D--2-    -fcase-strict-lower
-44: A0--  B--2-  C--2-  D---3
-45: A0--  B--2-  C---3  D0---
-46: A0--  B--2-  C---3  D-1--
-47: A0--  B--2-  C---3  D--2-
-48: A0--  B--2-  C---3  D---3
-49: A0--  B---3  C0---  D0---
-50: A0--  B---3  C0---  D-1--
-51: A0--  B---3  C0---  D--2-
-52: A0--  B---3  C0---  D---3
-53: A0--  B---3  C-1--  D0---
-54: A0--  B---3  C-1--  D-1--
-55: A0--  B---3  C-1--  D--2-
-56: A0--  B---3  C-1--  D---3
-57: A0--  B---3  C--2-  D0---
-58: A0--  B---3  C--2-  D-1--
-59: A0--  B---3  C--2-  D--2-
-60: A0--  B---3  C--2-  D---3
-61: A0--  B---3  C---3  D0---
-62: A0--  B---3  C---3  D-1--
-63: A0--  B---3  C---3  D--2-
-64: A0--  B---3  C---3  D---3    -fcase-initcap
-65: A-1-  B01--  C01--  D01--    -fcase-upper
-66: A--2  B0-2-  C0-2-  D0-2-    -fcase-lower
-@end smallexample
-
-Number 22 is the ``strict'' ANSI FORTRAN 77 model wherein all input
-(except comments, character constants, and Hollerith strings) must
-be entered in uppercase.
-Use @option{-fcase-strict-upper} to specify this
-combination.
-
-Number 43 is like Number 22 except all input must be lowercase.  Use
-@option{-fcase-strict-lower} to specify this combination.
-
-Number 65 is the ``classic'' ANSI FORTRAN 77 model as implemented on many
-non-UNIX machines whereby all the source is translated to uppercase.
-Use @option{-fcase-upper} to specify this combination.
-
-Number 66 is the ``canonical'' UNIX model whereby all the source is
-translated to lowercase.
-Use @option{-fcase-lower} to specify this combination.
-
-There are a few nearly useless combinations:
-
-@smallexample
-67: A-1-  B01--  C01--  D--2-
-68: A-1-  B01--  C01--  D---3
-69: A-1-  B01--  C--23  D01--
-70: A-1-  B01--  C--23  D--2-
-71: A-1-  B01--  C--23  D---3
-72: A--2  B01--  C0-2-  D-1--
-73: A--2  B01--  C0-2-  D---3
-74: A--2  B01--  C-1-3  D0-2-
-75: A--2  B01--  C-1-3  D-1--
-76: A--2  B01--  C-1-3  D---3
-@end smallexample
-
-The above allow some programs to be compiled but with restrictions that
-make most useful programs impossible: Numbers 67 and 72 warn about
-@emph{any} user-defined symbol names (such as @samp{SUBROUTINE FOO});
-Numbers
-68 and 73 warn about any user-defined symbol names longer than one
-character that don't have at least one non-alphabetic character after
-the first;
-Numbers 69 and 74 disallow any references to intrinsics;
-and Numbers 70, 71, 75, and 76 are combinations of the restrictions in
-67+69, 68+69, 72+74, and 73+74, respectively.
-
-All redundant combinations are shown in the above tables anyplace
-where more than one setting is shown for a low-level switch.
-For example, @samp{B0-2-} means either setting 0 or 2 is valid for switch B.
-The ``proper'' setting in such a case is the one that copies the setting
-of switch A---any other setting might slightly reduce the speed of
-the compiler, though possibly to an unmeasurable extent.
-
-All remaining combinations are useless in that they prevent successful
-compilation of non-null source files (source files with something other
-than comments).
-
-@node VXT Fortran
-@section VXT Fortran
-
-@cindex VXT extensions
-@cindex extensions, VXT
-@command{g77} supports certain constructs that
-have different meanings in VXT Fortran than they
-do in the GNU Fortran language.
-
-Generally, this manual uses the invented term VXT Fortran to refer
-VAX FORTRAN (circa v4).
-That compiler offered many popular features, though not necessarily
-those that are specific to the VAX processor architecture,
-the VMS operating system,
-or Digital Equipment Corporation's Fortran product line.
-(VAX and VMS probably are trademarks of Digital Equipment
-Corporation.)
-
-An extension offered by a Digital Fortran product that also is
-offered by several other Fortran products for different kinds of
-systems is probably going to be considered for inclusion in @command{g77}
-someday, and is considered a VXT Fortran feature.
-
-The @option{-fvxt} option generally specifies that, where
-the meaning of a construct is ambiguous (means one thing
-in GNU Fortran and another in VXT Fortran), the VXT Fortran
-meaning is to be assumed.
-
-@menu
-* Double Quote Meaning::  @samp{"2000} as octal constant.
-* Exclamation Point::     @samp{!} in column 6.
-@end menu
-
-@node Double Quote Meaning
-@subsection Meaning of Double Quote
-@cindex double quotes
-@cindex character constants
-@cindex constants, character
-@cindex octal constants
-@cindex constants, octal
-
-@command{g77} treats double-quote (@samp{"})
-as beginning an octal constant of @code{INTEGER(KIND=1)} type
-when the @option{-fvxt} option is specified.
-The form of this octal constant is
-
-@example
-"@var{octal-digits}
-@end example
-
-@noindent
-where @var{octal-digits} is a nonempty string of characters in
-the set @samp{01234567}.
-
-For example, the @option{-fvxt} option permits this:
-
-@example
-PRINT *, "20
-END
-@end example
-
-@noindent
-The above program would print the value @samp{16}.
-
-@xref{Integer Type}, for information on the preferred construct
-for integer constants specified using GNU Fortran's octal notation.
-
-(In the GNU Fortran language, the double-quote character (@samp{"})
-delimits a character constant just as does apostrophe (@samp{'}).
-There is no way to allow
-both constructs in the general case, since statements like
-@samp{PRINT *,"2000 !comment?"} would be ambiguous.)
-
-@node Exclamation Point
-@subsection Meaning of Exclamation Point in Column 6
-@cindex !
-@cindex exclamation point
-@cindex continuation character
-@cindex characters, continuation
-@cindex comment character
-@cindex characters, comment
-
-@command{g77} treats an exclamation point (@samp{!}) in column 6 of
-a fixed-form source file
-as a continuation character rather than
-as the beginning of a comment
-(as it does in any other column)
-when the @option{-fvxt} option is specified.
-
-The following program, when run, prints a message indicating
-whether it is interpreted according to GNU Fortran (and Fortran 90)
-rules or VXT Fortran rules:
-
-@smallexample
-C234567  (This line begins in column 1.)
-      I = 0
-     !1
-      IF (I.EQ.0) PRINT *, ' I am a VXT Fortran program'
-      IF (I.EQ.1) PRINT *, ' I am a Fortran 90 program'
-      IF (I.LT.0 .OR. I.GT.1) PRINT *, ' I am a HAL 9000 computer'
-      END
-@end smallexample
-
-(In the GNU Fortran and Fortran 90 languages, exclamation point is
-a valid character and, unlike space (@key{SPC}) or zero (@samp{0}),
-marks a line as a continuation line when it appears in column 6.)
-
-@node Fortran 90
-@section Fortran 90
-@cindex compatibility, Fortran 90
-@cindex Fortran 90, compatibility
-
-The GNU Fortran language includes a number of features that are
-part of Fortran 90, even when the @option{-ff90} option is not specified.
-The features enabled by @option{-ff90} are intended to be those that,
-when @option{-ff90} is not specified, would have another
-meaning to @command{g77}---usually meaning something invalid in the
-GNU Fortran language.
-
-So, the purpose of @option{-ff90} is not to specify whether @command{g77} is
-to gratuitously reject Fortran 90 constructs.
-The @option{-pedantic} option specified with @option{-fno-f90} is intended
-to do that, although its implementation is certainly incomplete at
-this point.
-
-When @option{-ff90} is specified:
-
-@itemize @bullet
-@item
-The type of @samp{REAL(@var{expr})} and @samp{AIMAG(@var{expr})},
-where @var{expr} is @code{COMPLEX} type,
-is the same type as the real part of @var{expr}.
-
-For example, assuming @samp{Z} is type @code{COMPLEX(KIND=2)},
-@samp{REAL(Z)} would return a value of type @code{REAL(KIND=2)},
-not of type @code{REAL(KIND=1)}, since @option{-ff90} is specified.
-@end itemize
-
-@node Pedantic Compilation
-@section Pedantic Compilation
-@cindex pedantic compilation
-@cindex compilation, pedantic
-
-The @option{-fpedantic} command-line option specifies that @command{g77}
-is to warn about code that is not standard-conforming.
-This is useful for finding
-some extensions @command{g77} accepts that other compilers might not accept.
-(Note that the @option{-pedantic} and @option{-pedantic-errors} options
-always imply @option{-fpedantic}.)
-
-With @option{-fno-f90} in force, ANSI FORTRAN 77 is used as the standard
-for conforming code.
-With @option{-ff90} in force, Fortran 90 is used.
-
-The constructs for which @command{g77} issues diagnostics when @option{-fpedantic}
-and @option{-fno-f90} are in force are:
-
-@itemize @bullet
-@item
-Automatic arrays, as in
-
-@example
-SUBROUTINE X(N)
-REAL A(N)
-@dots{}
-@end example
-
-@noindent
-where @samp{A} is not listed in any @code{ENTRY} statement,
-and thus is not a dummy argument.
-
-@item
-The commas in @samp{READ (5), I} and @samp{WRITE (10), J}.
-
-These commas are disallowed by FORTRAN 77, but, while strictly
-superfluous, are syntactically elegant,
-especially given that commas are required in statements such
-as @samp{READ 99, I} and @samp{PRINT *, J}.
-Many compilers permit the superfluous commas for this reason.
-
-@item
-@code{DOUBLE COMPLEX}, either explicitly or implicitly.
-
-An explicit use of this type is via a @code{DOUBLE COMPLEX} or
-@code{IMPLICIT DOUBLE COMPLEX} statement, for examples.
-
-An example of an implicit use is the expression @samp{C*D},
-where @samp{C} is @code{COMPLEX(KIND=1)}
-and @samp{D} is @code{DOUBLE PRECISION}.
-This expression is prohibited by ANSI FORTRAN 77
-because the rules of promotion would suggest that it
-produce a @code{DOUBLE COMPLEX} result---a type not
-provided for by that standard.
-
-@item
-Automatic conversion of numeric
-expressions to @code{INTEGER(KIND=1)} in contexts such as:
-
-@itemize @minus
-@item
-Array-reference indexes.
-@item
-Alternate-return values.
-@item
-Computed @code{GOTO}.
-@item
-@code{FORMAT} run-time expressions (not yet supported).
-@item
-Dimension lists in specification statements.
-@item
-Numbers for I/O statements (such as @samp{READ (UNIT=3.2), I})
-@item
-Sizes of @code{CHARACTER} entities in specification statements.
-@item
-Kind types in specification entities (a Fortran 90 feature).
-@item
-Initial, terminal, and incrementation parameters for implied-@code{DO}
-constructs in @code{DATA} statements.
-@end itemize
-
-@item
-Automatic conversion of @code{LOGICAL} expressions to @code{INTEGER}
-in contexts such as arithmetic @code{IF} (where @code{COMPLEX}
-expressions are disallowed anyway).
-
-@item
-Zero-size array dimensions, as in:
-
-@example
-INTEGER I(10,20,4:2)
-@end example
-
-@item
-Zero-length @code{CHARACTER} entities, as in:
-
-@example
-PRINT *, ''
-@end example
-
-@item
-Substring operators applied to character constants and named
-constants, as in:
-
-@example
-PRINT *, 'hello'(3:5)
-@end example
-
-@item
-Null arguments passed to statement function, as in:
-
-@example
-PRINT *, FOO(,3)
-@end example
-
-@item
-Disagreement among program units regarding whether a given @code{COMMON}
-area is @code{SAVE}d (for targets where program units in a single source
-file are ``glued'' together as they typically are for UNIX development
-environments).
-
-@item
-Disagreement among program units regarding the size of a
-named @code{COMMON} block.
-
-@item
-Specification statements following first @code{DATA} statement.
-
-(In the GNU Fortran language, @samp{DATA I/1/} may be followed by @samp{INTEGER J},
-but not @samp{INTEGER I}.
-The @option{-fpedantic} option disallows both of these.)
-
-@item
-Semicolon as statement separator, as in:
-
-@example
-CALL FOO; CALL BAR
-@end example
-@c
-@c @item
-@c Comma before list of I/O items in @code{WRITE}
-@c  @c, @code{ENCODE}, @code{DECODE}, and @code{REWRITE}
-@c statements, as with @code{READ} (as explained above).
-
-@item
-Use of @samp{&} in column 1 of fixed-form source (to indicate continuation).
-
-@item
-Use of @code{CHARACTER} constants to initialize numeric entities, and vice
-versa.
-
-@item
-Expressions having two arithmetic operators in a row, such
-as @samp{X*-Y}.
-@end itemize
-
-If @option{-fpedantic} is specified along with @option{-ff90}, the
-following constructs result in diagnostics:
-
-@itemize @bullet
-@item
-Use of semicolon as a statement separator on a line
-that has an @code{INCLUDE} directive.
-@end itemize
-
-@node Distensions
-@section Distensions
-@cindex distensions
-@cindex ugly features
-@cindex features, ugly
-
-The @option{-fugly-*} command-line options determine whether certain
-features supported by VAX FORTRAN and other such compilers, but considered
-too ugly to be in code that can be changed to use safer and/or more
-portable constructs, are accepted.
-These are humorously referred to as ``distensions'',
-extensions that just plain look ugly in the harsh light of day.
-
-@menu
-* Ugly Implicit Argument Conversion::  Disabled via @option{-fno-ugly-args}.
-* Ugly Assumed-Size Arrays::           Enabled via @option{-fugly-assumed}.
-* Ugly Null Arguments::                Enabled via @option{-fugly-comma}.
-* Ugly Complex Part Extraction::       Enabled via @option{-fugly-complex}.
-* Ugly Conversion of Initializers::    Disabled via @option{-fno-ugly-init}.
-* Ugly Integer Conversions::           Enabled via @option{-fugly-logint}.
-* Ugly Assigned Labels::               Enabled via @option{-fugly-assign}.
-@end menu
-
-@node Ugly Implicit Argument Conversion
-@subsection Implicit Argument Conversion
-@cindex Hollerith constants
-@cindex constants, Hollerith
-
-The @option{-fno-ugly-args} option disables
-passing typeless and Hollerith constants as actual arguments
-in procedure invocations.
-For example:
-
-@example
-CALL FOO(4HABCD)
-CALL BAR('123'O)
-@end example
-
-@noindent
-These constructs can be too easily used to create non-portable
-code, but are not considered as ``ugly'' as others.
-Further, they are widely used in existing Fortran source code
-in ways that often are quite portable.
-Therefore, they are enabled by default.
-
-@node Ugly Assumed-Size Arrays
-@subsection Ugly Assumed-Size Arrays
-@cindex arrays, assumed-size
-@cindex assumed-size arrays
-@cindex DIMENSION X(1)
-
-The @option{-fugly-assumed} option enables
-the treatment of any array with a final dimension specified as @samp{1}
-as an assumed-size array, as if @samp{*} had been specified
-instead.
-
-For example, @samp{DIMENSION X(1)} is treated as if it
-had read @samp{DIMENSION X(*)} if @samp{X} is listed as
-a dummy argument in a preceding @code{SUBROUTINE}, @code{FUNCTION},
-or @code{ENTRY} statement in the same program unit.
-
-Use an explicit lower bound to avoid this interpretation.
-For example, @samp{DIMENSION X(1:1)} is never treated as if
-it had read @samp{DIMENSION X(*)} or @samp{DIMENSION X(1:*)}.
-Nor is @samp{DIMENSION X(2-1)} affected by this option,
-since that kind of expression is unlikely to have been
-intended to designate an assumed-size array.
-
-This option is used to prevent warnings being issued about apparent
-out-of-bounds reference such as @samp{X(2) = 99}.
-
-It also prevents the array from being used in contexts that
-disallow assumed-size arrays, such as @samp{PRINT *,X}.
-In such cases, a diagnostic is generated and the source file is
-not compiled.
-
-The construct affected by this option is used only in old code
-that pre-exists the widespread acceptance of adjustable and assumed-size
-arrays in the Fortran community.
-
-@emph{Note:} This option does not affect how @samp{DIMENSION X(1)} is
-treated if @samp{X} is listed as a dummy argument only
-@emph{after} the @code{DIMENSION} statement (presumably in
-an @code{ENTRY} statement).
-For example, @option{-fugly-assumed} has no effect on the
-following program unit:
-
-@example
-SUBROUTINE X
-REAL A(1)
-RETURN
-ENTRY Y(A)
-PRINT *, A
-END
-@end example
-
-@node Ugly Complex Part Extraction
-@subsection Ugly Complex Part Extraction
-@cindex complex values
-@cindex real part
-@cindex imaginary part
-
-The @option{-fugly-complex} option enables
-use of the @code{REAL()} and @code{AIMAG()}
-intrinsics with arguments that are
-@code{COMPLEX} types other than @code{COMPLEX(KIND=1)}.
-
-With @option{-ff90} in effect, these intrinsics return
-the unconverted real and imaginary parts (respectively)
-of their argument.
-
-With @option{-fno-f90} in effect, these intrinsics convert
-the real and imaginary parts to @code{REAL(KIND=1)}, and return
-the result of that conversion.
-
-Due to this ambiguity, the GNU Fortran language defines
-these constructs as invalid, except in the specific
-case where they are entirely and solely passed as an
-argument to an invocation of the @code{REAL()} intrinsic.
-For example,
-
-@example
-REAL(REAL(Z))
-@end example
-
-@noindent
-is permitted even when @samp{Z} is @code{COMPLEX(KIND=2)}
-and @option{-fno-ugly-complex} is in effect, because the
-meaning is clear.
-
-@command{g77} enforces this restriction, unless @option{-fugly-complex}
-is specified, in which case the appropriate interpretation is
-chosen and no diagnostic is issued.
-
-@xref{CMPAMBIG}, for information on how to cope with existing
-code with unclear expectations of @code{REAL()} and @code{AIMAG()}
-with @code{COMPLEX(KIND=2)} arguments.
-
-@xref{RealPart Intrinsic}, for information on the @code{REALPART()}
-intrinsic, used to extract the real part of a complex expression
-without conversion.
-@xref{ImagPart Intrinsic}, for information on the @code{IMAGPART()}
-intrinsic, used to extract the imaginary part of a complex expression
-without conversion.
-
-@node Ugly Null Arguments
-@subsection Ugly Null Arguments
-@cindex trailing comma
-@cindex comma, trailing
-@cindex characters, comma
-@cindex null arguments
-@cindex arguments, null
-
-The @option{-fugly-comma} option enables use of a single trailing comma
-to mean ``pass an extra trailing null argument''
-in a list of actual arguments to an external procedure,
-and use of an empty list of arguments to such a procedure
-to mean ``pass a single null argument''.
-
-@cindex omitting arguments
-@cindex arguments, omitting
-(Null arguments often are used in some procedure-calling
-schemes to indicate omitted arguments.)
-
-For example, @samp{CALL FOO(,)} means ``pass
-two null arguments'', rather than ``pass one null argument''.
-Also, @samp{CALL BAR()} means ``pass one null argument''.
-
-This construct is considered ``ugly'' because it does not
-provide an elegant way to pass a single null argument
-that is syntactically distinct from passing no arguments.
-That is, this construct changes the meaning of code that
-makes no use of the construct.
-
-So, with @option{-fugly-comma} in force, @samp{CALL FOO()}
-and @samp{I = JFUNC()} pass a single null argument, instead
-of passing no arguments as required by the Fortran 77 and
-90 standards.
-
-@emph{Note:} Many systems gracefully allow the case
-where a procedure call passes one extra argument that the
-called procedure does not expect.
-
-So, in practice, there might be no difference in
-the behavior of a program that does @samp{CALL FOO()}
-or @samp{I = JFUNC()} and is compiled with @option{-fugly-comma}
-in force as compared to its behavior when compiled
-with the default, @option{-fno-ugly-comma}, in force,
-assuming @samp{FOO} and @samp{JFUNC} do not expect any
-arguments to be passed.
-
-@node Ugly Conversion of Initializers
-@subsection Ugly Conversion of Initializers
-
-The constructs disabled by @option{-fno-ugly-init} are:
-
-@itemize @bullet
-@cindex Hollerith constants
-@cindex constants, Hollerith
-@item
-Use of Hollerith and typeless constants in contexts where they set
-initial (compile-time) values for variables, arrays, and named
-constants---that is, @code{DATA} and @code{PARAMETER} statements, plus
-type-declaration statements specifying initial values.
-
-Here are some sample initializations that are disabled by the
-@option{-fno-ugly-init} option:
-
-@example
-PARAMETER (VAL='9A304FFE'X)
-REAL*8 STRING/8HOUTPUT00/
-DATA VAR/4HABCD/
-@end example
-
-@cindex character constants
-@cindex constants, character
-@item
-In the same contexts as above, use of character constants to initialize
-numeric items and vice versa (one constant per item).
-
-Here are more sample initializations that are disabled by the
-@option{-fno-ugly-init} option:
-
-@example
-INTEGER IA
-CHARACTER BELL
-PARAMETER (IA = 'A')
-PARAMETER (BELL = 7)
-@end example
-
-@item
-Use of Hollerith and typeless constants on the right-hand side
-of assignment statements to numeric types, and in other
-contexts (such as passing arguments in invocations of
-intrinsic procedures and statement functions) that
-are treated as assignments to known types (the dummy
-arguments, in these cases).
-
-Here are sample statements that are disabled by the
-@option{-fno-ugly-init} option:
-
-@example
-IVAR = 4HABCD
-PRINT *, IMAX0(2HAB, 2HBA)
-@end example
-@end itemize
-
-The above constructs, when used,
-can tend to result in non-portable code.
-But, they are widely used in existing Fortran code in ways
-that often are quite portable.
-Therefore, they are enabled by default.
-
-@node Ugly Integer Conversions
-@subsection Ugly Integer Conversions
-
-The constructs enabled via @option{-fugly-logint} are:
-
-@itemize @bullet
-@item
-Automatic conversion between @code{INTEGER} and @code{LOGICAL} as
-dictated by
-context (typically implies nonportable dependencies on how a
-particular implementation encodes @code{.TRUE.} and @code{.FALSE.}).
-
-@item
-Use of a @code{LOGICAL} variable in @code{ASSIGN} and assigned-@code{GOTO}
-statements.
-@end itemize
-
-The above constructs are disabled by default because use
-of them tends to lead to non-portable code.
-Even existing Fortran code that uses that often turns out
-to be non-portable, if not outright buggy.
-
-Some of this is due to differences among implementations as
-far as how @code{.TRUE.} and @code{.FALSE.} are encoded as
-@code{INTEGER} values---Fortran code that assumes a particular
-coding is likely to use one of the above constructs, and is
-also likely to not work correctly on implementations using
-different encodings.
-
-@xref{Equivalence Versus Equality}, for more information.
-
-@node Ugly Assigned Labels
-@subsection Ugly Assigned Labels
-@cindex ASSIGN statement
-@cindex statements, ASSIGN
-@cindex assigned labels
-@cindex pointers
-
-The @option{-fugly-assign} option forces @command{g77} to use the
-same storage for assigned labels as it would for a normal
-assignment to the same variable.
-
-For example, consider the following code fragment:
-
-@example
-I = 3
-ASSIGN 10 TO I
-@end example
-
-@noindent
-Normally, for portability and improved diagnostics, @command{g77}
-reserves distinct storage for a ``sibling'' of @samp{I}, used
-only for @code{ASSIGN} statements to that variable (along with
-the corresponding assigned-@code{GOTO} and assigned-@code{FORMAT}-I/O
-statements that reference the variable).
-
-However, some code (that violates the ANSI FORTRAN 77 standard)
-attempts to copy assigned labels among variables involved with
-@code{ASSIGN} statements, as in:
-
-@example
-ASSIGN 10 TO I
-ISTATE(5) = I
-@dots{}
-J = ISTATE(ICUR)
-GOTO J
-@end example
-
-@noindent
-Such code doesn't work under @command{g77} unless @option{-fugly-assign}
-is specified on the command-line, ensuring that the value of @code{I}
-referenced in the second line is whatever value @command{g77} uses
-to designate statement label @samp{10}, so the value may be
-copied into the @samp{ISTATE} array, later retrieved into a
-variable of the appropriate type (@samp{J}), and used as the target of
-an assigned-@code{GOTO} statement.
-
-@emph{Note:} To avoid subtle program bugs,
-when @option{-fugly-assign} is specified,
-@command{g77} requires the type of variables
-specified in assigned-label contexts
-@emph{must} be the same type returned by @code{%LOC()}.
-On many systems, this type is effectively the same
-as @code{INTEGER(KIND=1)}, while, on others, it is
-effectively the same as @code{INTEGER(KIND=2)}.
-
-Do @emph{not} depend on @command{g77} actually writing valid pointers
-to these variables, however.
-While @command{g77} currently chooses that implementation, it might
-be changed in the future.
-
-@xref{Assigned Statement Labels,,Assigned Statement Labels (ASSIGN and GOTO)},
-for implementation details on assigned-statement labels.
-
-@node Compiler
-@chapter The GNU Fortran Compiler
-
-The GNU Fortran compiler, @command{g77}, supports programs written
-in the GNU Fortran language and in some other dialects of Fortran.
-
-Some aspects of how @command{g77} works are universal regardless
-of dialect, and yet are not properly part of the GNU Fortran
-language itself.
-These are described below.
-
-@emph{Note: This portion of the documentation definitely needs a lot
-of work!}
-
-@menu
-* Compiler Limits::
-* Run-time Environment Limits::
-* Compiler Types::
-* Compiler Constants::
-* Compiler Intrinsics::
-@end menu
-
-@node Compiler Limits
-@section Compiler Limits
-@cindex limits, compiler
-@cindex compiler limits
-
-@command{g77}, as with GNU tools in general, imposes few arbitrary restrictions
-on lengths of identifiers, number of continuation lines, number of external
-symbols in a program, and so on.
-
-@cindex options, -Nl
-@cindex -Nl option
-@cindex options, -Nx
-@cindex -Nx option
-@cindex limits, continuation lines
-@cindex limits, lengths of names
-For example, some other Fortran compiler have an option
-(such as @option{-Nl@var{x}}) to increase the limit on the
-number of continuation lines.
-Also, some Fortran compilation systems have an option
-(such as @option{-Nx@var{x}}) to increase the limit on the
-number of external symbols.
-
-@command{g77}, @command{gcc}, and GNU @command{ld} (the GNU linker) have
-no equivalent options, since they do not impose arbitrary
-limits in these areas.
-
-@cindex rank, maximum
-@cindex maximum rank
-@cindex number of dimensions, maximum
-@cindex maximum number of dimensions
-@cindex limits, rank
-@cindex limits, array dimensions
-@command{g77} does currently limit the number of dimensions in an array
-to the same degree as do the Fortran standards---seven (7).
-This restriction might be lifted in a future version.
-
-@node Run-time Environment Limits
-@section Run-time Environment Limits
-@cindex limits, run-time library
-@cindex wraparound
-
-As a portable Fortran implementation,
-@command{g77} offers its users direct access to,
-and otherwise depends upon,
-the underlying facilities of the system
-used to build @command{g77},
-the system on which @command{g77} itself is used to compile programs,
-and the system on which the @command{g77}-compiled program is actually run.
-(For most users, the three systems are of the same
-type---combination of operating environment and hardware---often
-the same physical system.)
-
-The run-time environment for a particular system
-inevitably imposes some limits on a program's use
-of various system facilities.
-These limits vary from system to system.
-
-Even when such limits might be well beyond the
-possibility of being encountered on a particular system,
-the @command{g77} run-time environment
-has certain built-in limits,
-usually, but not always, stemming from intrinsics
-with inherently limited interfaces.
-
-Currently, the @command{g77} run-time environment
-does not generally offer a less-limiting environment
-by augmenting the underlying system's own environment.
-
-Therefore, code written in the GNU Fortran language,
-while syntactically and semantically portable,
-might nevertheless make non-portable assumptions
-about the run-time environment---assumptions that
-prove to be false for some particular environments.
-
-The GNU Fortran language,
-the @command{g77} compiler and run-time environment,
-and the @command{g77} documentation
-do not yet offer comprehensive portable work-arounds for such limits,
-though programmers should be able to
-find their own in specific instances.
-
-Not all of the limitations are described in this document.
-Some of the known limitations include:
-
-@menu
-* Timer Wraparounds::
-* Year 2000 (Y2K) Problems::
-* Array Size::
-* Character-variable Length::
-* Year 10000 (Y10K) Problems::
-@end menu
-
-@node Timer Wraparounds
-@subsection Timer Wraparounds
-
-Intrinsics that return values computed from system timers,
-whether elapsed (wall-clock) timers,
-process CPU timers,
-or other kinds of timers,
-are prone to experiencing wrap-around errors
-(or returning wrapped-around values from successive calls)
-due to insufficient ranges
-offered by the underlying system's timers.
-
-@cindex negative time
-@cindex short time
-@cindex long time
-Some of the symptoms of such behaviors include
-apparently negative time being computed for a duration,
-an extremely short amount of time being computed for a long duration,
-and an extremely long amount of time being computed for a short duration.
-
-See the following for intrinsics
-known to have potential problems in these areas
-on at least some systems:
-@ref{CPU_Time Intrinsic},
-@ref{DTime Intrinsic (function)}, @ref{DTime Intrinsic (subroutine)},
-@ref{ETime Intrinsic (function)}, @ref{ETime Intrinsic (subroutine)},
-@ref{MClock Intrinsic}, @ref{MClock8 Intrinsic},
-@ref{Secnds Intrinsic},
-@ref{Second Intrinsic (function)}, @ref{Second Intrinsic (subroutine)},
-@ref{System_Clock Intrinsic},
-@ref{Time Intrinsic (UNIX)}, @ref{Time Intrinsic (VXT)},
-@ref{Time8 Intrinsic}.
-
-@node Year 2000 (Y2K) Problems
-@subsection Year 2000 (Y2K) Problems
-@cindex Y2K compliance
-@cindex Year 2000 compliance
-
-While the @command{g77} compiler itself is believed to
-be Year-2000 (Y2K) compliant,
-some intrinsics are not,
-and, potentially, some underlying systems are not,
-perhaps rendering some Y2K-compliant intrinsics
-non-compliant when used on those particular systems.
-
-Fortran code that uses non-Y2K-compliant intrinsics
-(listed below)
-is, itself, almost certainly not compliant,
-and should be modified to use Y2K-compliant intrinsics instead.
-
-Fortran code that uses no non-Y2K-compliant intrinsics,
-but which currently is running on a non-Y2K-compliant system,
-can be made more Y2K compliant by compiling and
-linking it for use on a new Y2K-compliant system,
-such as a new version of an old, non-Y2K-compliant, system.
-
-Currently, information on Y2K and related issues
-is being maintained at
-@uref{http://www.gnu.org/software/year2000-list.html}.
-
-See the following for intrinsics
-known to have potential problems in these areas
-on at least some systems:
-@ref{Date Intrinsic},
-@ref{IDate Intrinsic (VXT)}.
-
-@cindex y2kbuggy
-@cindex date_y2kbuggy_0
-@cindex vxtidate_y2kbuggy_0
-@cindex G77_date_y2kbuggy_0
-@cindex G77_vxtidate_y2kbuggy_0
-The @code{libg2c} library
-shipped with any @command{g77} that warns
-about invocation of a non-Y2K-compliant intrinsic
-has renamed the @code{EXTERNAL} procedure names
-of those intrinsics.
-This is done so that
-the @code{libg2c} implementations of these intrinsics
-cannot be directly linked to
-as @code{EXTERNAL} names
-(which normally would avoid the non-Y2K-intrinsic warning).
-
-The renamed forms of the @code{EXTERNAL} names
-of these renamed procedures
-may be linked to
-by appending the string @samp{_y2kbug}
-to the name of the procedure
-in the source code.
-For example:
-
-@smallexample
-CHARACTER*20 STR
-INTEGER YY, MM, DD
-EXTERNAL DATE_Y2KBUG, VXTIDATE_Y2KBUG
-CALL DATE_Y2KBUG (STR)
-CALL VXTIDATE_Y2KBUG (MM, DD, YY)
-@end smallexample
-
-(Note that the @code{EXTERNAL} statement
-is not actually required,
-since the modified names are not recognized as intrinsics
-by the current version of @command{g77}.
-But it is shown in this specific case,
-for purposes of illustration.)
-
-The renaming of @code{EXTERNAL} procedure names of these intrinsics
-causes unresolved references at link time.
-For example, @samp{EXTERNAL DATE; CALL DATE(STR)}
-is normally compiled by @command{g77}
-as, in C, @samp{date_(&str, 20);}.
-This, in turn, links to the @code{date_} procedure
-in the @code{libE77} portion of @code{libg2c},
-which purposely calls a nonexistent procedure
-named @code{G77_date_y2kbuggy_0}.
-The resulting link-time error is designed, via this name,
-to encourage the programmer to look up the
-index entries to this portion of the @command{g77} documentation.
-
-Generally, we recommend that the @code{EXTERNAL} method
-of invoking procedures in @code{libg2c}
-@emph{not} be used.
-When used, some of the correctness checking
-normally performed by @command{g77}
-is skipped.
-
-In particular, it is probably better to use the
-@code{INTRINSIC} method of invoking
-non-Y2K-compliant procedures,
-so anyone compiling the code
-can quickly notice the potential Y2K problems
-(via the warnings printing by @command{g77})
-without having to even look at the code itself.
-
-If there are problems linking @code{libg2c}
-to code compiled by @command{g77}
-that involve the string @samp{y2kbug},
-and these are not explained above,
-that probably indicates
-that a version of @code{libg2c}
-older than @command{g77}
-is being linked to,
-or that the new library is being linked
-to code compiled by an older version of @command{g77}.
-
-That's because, as of the version that warns about
-non-Y2K-compliant intrinsic invocation,
-@command{g77} references the @code{libg2c} implementations
-of those intrinsics
-using new names, containing the string @samp{y2kbug}.
-
-So, linking newly-compiled code
-(invoking one of the intrinsics in question)
-to an old library
-might yield an unresolved reference
-to @code{G77_date_y2kbug_0}.
-(The old library calls it @code{G77_date_0}.)
-
-Similarly, linking previously-compiled code
-to a new library
-might yield an unresolved reference
-to @code{G77_vxtidate_0}.
-(The new library calls it @code{G77_vxtidate_y2kbug_0}.)
-
-The proper fix for the above problems
-is to obtain the latest release of @command{g77}
-and related products
-(including @code{libg2c})
-and install them on all systems,
-then recompile, relink, and install
-(as appropriate)
-all existing Fortran programs.
-
-(Normally, this sort of renaming is steadfastly avoided.
-In this case, however, it seems more important to highlight
-potential Y2K problems
-than to ease the transition
-of potentially non-Y2K-compliant code
-to new versions of @command{g77} and @code{libg2c}.)
-
-@node Array Size
-@subsection Array Size
-@cindex limits, array size
-@cindex array size
-
-Currently, @command{g77} uses the default @code{INTEGER} type
-for array indexes,
-which limits the sizes of single-dimension arrays
-on systems offering a larger address space
-than can be addressed by that type.
-(That @command{g77} puts all arrays in memory
-could be considered another limitation---it
-could use large temporary files---but that decision
-is left to the programmer as an implementation choice
-by most Fortran implementations.)
-
-@c ??? Investigate this, to offer a more clear statement
-@c than the following paragraphs do.  -- burley 1999-02-17
-It is not yet clear whether this limitation
-never, sometimes, or always applies to the
-sizes of multiple-dimension arrays as a whole.
-
-For example, on a system with 64-bit addresses
-and 32-bit default @code{INTEGER},
-an array with a size greater than can be addressed
-by a 32-bit offset
-can be declared using multiple dimensions.
-Such an array is therefore larger
-than a single-dimension array can be,
-on the same system.
-
-@cindex limits, multi-dimension arrays
-@cindex multi-dimension arrays
-@cindex arrays, dimensioning
-Whether large multiple-dimension arrays are reliably supported
-depends mostly on the @command{gcc} back end (code generator)
-used by @command{g77}, and has not yet been fully investigated.
-
-@node Character-variable Length
-@subsection Character-variable Length
-@cindex limits, on character-variable length
-@cindex character-variable length
-
-Currently, @command{g77} uses the default @code{INTEGER} type
-for the lengths of @code{CHARACTER} variables
-and array elements.
-
-This means that, for example,
-a system with a 64-bit address space
-and a 32-bit default @code{INTEGER} type
-does not, under @command{g77},
-support a @code{CHARACTER*@var{n}} declaration
-where @var{n} is greater than 2147483647.
-
-@node Year 10000 (Y10K) Problems
-@subsection Year 10000 (Y10K) Problems
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-
-Most intrinsics returning, or computing values based on,
-date information are prone to Year-10000 (Y10K) problems,
-due to supporting only 4 digits for the year.
-
-See the following for examples:
-@ref{FDate Intrinsic (function)}, @ref{FDate Intrinsic (subroutine)},
-@ref{IDate Intrinsic (UNIX)},
-@ref{Time Intrinsic (VXT)},
-@ref{Date_and_Time Intrinsic}.
-
-@node Compiler Types
-@section Compiler Types
-@cindex types, of data
-@cindex data types
-
-Fortran implementations have a fair amount of freedom given them by the
-standard as far as how much storage space is used and how much precision
-and range is offered by the various types such as @code{LOGICAL(KIND=1)},
-@code{INTEGER(KIND=1)}, @code{REAL(KIND=1)}, @code{REAL(KIND=2)},
-@code{COMPLEX(KIND=1)}, and @code{CHARACTER}.
-Further, many compilers offer so-called @samp{*@var{n}} notation, but
-the interpretation of @var{n} varies across compilers and target architectures.
-
-The standard requires that @code{LOGICAL(KIND=1)}, @code{INTEGER(KIND=1)},
-and @code{REAL(KIND=1)}
-occupy the same amount of storage space, and that @code{COMPLEX(KIND=1)}
-and @code{REAL(KIND=2)} take twice as much storage space as @code{REAL(KIND=1)}.
-Further, it requires that @code{COMPLEX(KIND=1)}
-entities be ordered such that when a @code{COMPLEX(KIND=1)} variable is
-storage-associated (such as via @code{EQUIVALENCE})
-with a two-element @code{REAL(KIND=1)} array named @samp{R}, @samp{R(1)}
-corresponds to the real element and @samp{R(2)} to the imaginary
-element of the @code{COMPLEX(KIND=1)} variable.
-
-(Few requirements as to precision or ranges of any of these are
-placed on the implementation, nor is the relationship of storage sizes of
-these types to the @code{CHARACTER} type specified, by the standard.)
-
-@command{g77} follows the above requirements, warning when compiling
-a program requires placement of items in memory that contradict the
-requirements of the target architecture.
-(For example, a program can require placement of a @code{REAL(KIND=2)}
-on a boundary that is not an even multiple of its size, but still an
-even multiple of the size of a @code{REAL(KIND=1)} variable.
-On some target architectures, using the canonical
-mapping of Fortran types to underlying architectural types, such
-placement is prohibited by the machine definition or
-the Application Binary Interface (ABI) in force for
-the configuration defined for building @command{gcc} and @command{g77}.
-@command{g77} warns about such
-situations when it encounters them.)
-
-@command{g77} follows consistent rules for configuring the mapping between Fortran
-types, including the @samp{*@var{n}} notation, and the underlying architectural
-types as accessed by a similarly-configured applicable version of the
-@command{gcc} compiler.
-These rules offer a widely portable, consistent Fortran/C
-environment, although they might well conflict with the expectations of
-users of Fortran compilers designed and written for particular
-architectures.
-
-These rules are based on the configuration that is in force for the
-version of @command{gcc} built in the same release as @command{g77} (and
-which was therefore used to build both the @command{g77} compiler
-components and the @code{libg2c} run-time library):
-
-@table @code
-@cindex REAL(KIND=1) type
-@cindex types, REAL(KIND=1)
-@item REAL(KIND=1)
-Same as @code{float} type.
-
-@cindex REAL(KIND=2) type
-@cindex types, REAL(KIND=2)
-@item REAL(KIND=2)
-Same as whatever floating-point type that is twice the size
-of a @code{float}---usually, this is a @code{double}.
-
-@cindex INTEGER(KIND=1) type
-@cindex types, INTEGER(KIND=1)
-@item INTEGER(KIND=1)
-Same as an integral type that is occupies the same amount
-of memory storage as @code{float}---usually, this is either
-an @code{int} or a @code{long int}.
-
-@cindex LOGICAL(KIND=1) type
-@cindex types, LOGICAL(KIND=1)
-@item LOGICAL(KIND=1)
-Same @command{gcc} type as @code{INTEGER(KIND=1)}.
-
-@cindex INTEGER(KIND=2) type
-@cindex types, INTEGER(KIND=2)
-@item INTEGER(KIND=2)
-Twice the size, and usually nearly twice the range,
-as @code{INTEGER(KIND=1)}---usually, this is either
-a @code{long int} or a @code{long long int}.
-
-@cindex LOGICAL(KIND=2) type
-@cindex types, LOGICAL(KIND=2)
-@item LOGICAL(KIND=2)
-Same @command{gcc} type as @code{INTEGER(KIND=2)}.
-
-@cindex INTEGER(KIND=3) type
-@cindex types, INTEGER(KIND=3)
-@item INTEGER(KIND=3)
-Same @command{gcc} type as signed @code{char}.
-
-@cindex LOGICAL(KIND=3) type
-@cindex types, LOGICAL(KIND=3)
-@item LOGICAL(KIND=3)
-Same @command{gcc} type as @code{INTEGER(KIND=3)}.
-
-@cindex INTEGER(KIND=6) type
-@cindex types, INTEGER(KIND=6)
-@item INTEGER(KIND=6)
-Twice the size, and usually nearly twice the range,
-as @code{INTEGER(KIND=3)}---usually, this is
-a @code{short}.
-
-@cindex LOGICAL(KIND=6) type
-@cindex types, LOGICAL(KIND=6)
-@item LOGICAL(KIND=6)
-Same @command{gcc} type as @code{INTEGER(KIND=6)}.
-
-@cindex COMPLEX(KIND=1) type
-@cindex types, COMPLEX(KIND=1)
-@item COMPLEX(KIND=1)
-Two @code{REAL(KIND=1)} scalars (one for the real part followed by
-one for the imaginary part).
-
-@cindex COMPLEX(KIND=2) type
-@cindex types, COMPLEX(KIND=2)
-@item COMPLEX(KIND=2)
-Two @code{REAL(KIND=2)} scalars.
-
-@cindex *@var{n} notation
-@item @var{numeric-type}*@var{n}
-(Where @var{numeric-type} is any type other than @code{CHARACTER}.)
-Same as whatever @command{gcc} type occupies @var{n} times the storage
-space of a @command{gcc} @code{char} item.
-
-@cindex DOUBLE PRECISION type
-@cindex types, DOUBLE PRECISION
-@item DOUBLE PRECISION
-Same as @code{REAL(KIND=2)}.
-
-@cindex DOUBLE COMPLEX type
-@cindex types, DOUBLE COMPLEX
-@item DOUBLE COMPLEX
-Same as @code{COMPLEX(KIND=2)}.
-@end table
-
-Note that the above are proposed correspondences and might change
-in future versions of @command{g77}---avoid writing code depending
-on them.
-
-Other types supported by @command{g77}
-are derived from gcc types such as @code{char}, @code{short},
-@code{int}, @code{long int}, @code{long long int}, @code{long double},
-and so on.
-That is, whatever types @command{gcc} already supports, @command{g77} supports
-now or probably will support in a future version.
-The rules for the @samp{@var{numeric-type}*@var{n}} notation
-apply to these types,
-and new values for @samp{@var{numeric-type}(KIND=@var{n})} will be
-assigned in a way that encourages clarity, consistency, and portability.
-
-@node Compiler Constants
-@section Compiler Constants
-@cindex constants
-@cindex types, constants
-
-@command{g77} strictly assigns types to @emph{all} constants not
-documented as ``typeless'' (typeless constants including @samp{'1'Z},
-for example).
-Many other Fortran compilers attempt to assign types to typed constants
-based on their context.
-This results in hard-to-find bugs, nonportable
-code, and is not in the spirit (though it strictly follows the letter)
-of the 77 and 90 standards.
-
-@command{g77} might offer, in a future release, explicit constructs by
-which a wider variety of typeless constants may be specified, and/or
-user-requested warnings indicating places where @command{g77} might differ
-from how other compilers assign types to constants.
-
-@xref{Context-Sensitive Constants}, for more information on this issue.
-
-@node Compiler Intrinsics
-@section Compiler Intrinsics
-
-@command{g77} offers an ever-widening set of intrinsics.
-Currently these all are procedures (functions and subroutines).
-
-Some of these intrinsics are unimplemented, but their names reserved
-to reduce future problems with existing code as they are implemented.
-Others are implemented as part of the GNU Fortran language, while
-yet others are provided for compatibility with other dialects of
-Fortran but are not part of the GNU Fortran language.
-
-To manage these distinctions, @command{g77} provides intrinsic @emph{groups},
-a facility that is simply an extension of the intrinsic groups provided
-by the GNU Fortran language.
-
-@menu
-* Intrinsic Groups::  How intrinsics are grouped for easy management.
-* Other Intrinsics::  Intrinsics other than those in the GNU
-                       Fortran language.
-@end menu
-
-@node Intrinsic Groups
-@subsection Intrinsic Groups
-@cindex groups of intrinsics
-@cindex intrinsics, groups
-
-A given specific intrinsic belongs in one or more groups.
-Each group is deleted, disabled, hidden, or enabled
-by default or a command-line option.
-The meaning of each term follows.
-
-@table @b
-@cindex deleted intrinsics
-@cindex intrinsics, deleted
-@item Deleted
-No intrinsics are recognized as belonging to that group.
-
-@cindex disabled intrinsics
-@cindex intrinsics, disabled
-@item Disabled
-Intrinsics are recognized as belonging to the group, but
-references to them (other than via the @code{INTRINSIC} statement)
-are disallowed through that group.
-
-@cindex hidden intrinsics
-@cindex intrinsics, hidden
-@item Hidden
-Intrinsics in that group are recognized and enabled (if implemented)
-@emph{only} if the first mention of the actual name of an intrinsic
-in a program unit is in an @code{INTRINSIC} statement.
-
-@cindex enabled intrinsics
-@cindex intrinsics, enabled
-@item Enabled
-Intrinsics in that group are recognized and enabled (if implemented).
-@end table
-
-The distinction between deleting and disabling a group is illustrated
-by the following example.
-Assume intrinsic @samp{FOO} belongs only to group @samp{FGR}.
-If group @samp{FGR} is deleted, the following program unit will
-successfully compile, because @samp{FOO()} will be seen as a
-reference to an external function named @samp{FOO}:
-
-@example
-PRINT *, FOO()
-END
-@end example
-
-@noindent
-If group @samp{FGR} is disabled, compiling the above program will produce
-diagnostics, either because the @samp{FOO} intrinsic is improperly invoked
-or, if properly invoked, it is not enabled.
-To change the above program so it references an external function @samp{FOO}
-instead of the disabled @samp{FOO} intrinsic,
-add the following line to the top:
-
-@example
-EXTERNAL FOO
-@end example
-
-@noindent
-So, deleting a group tells @command{g77} to pretend as though the intrinsics in
-that group do not exist at all, whereas disabling it tells @command{g77} to
-recognize them as (disabled) intrinsics in intrinsic-like contexts.
-
-Hiding a group is like enabling it, but the intrinsic must be first
-named in an @code{INTRINSIC} statement to be considered a reference to the
-intrinsic rather than to an external procedure.
-This might be the ``safest'' way to treat a new group of intrinsics
-when compiling old
-code, because it allows the old code to be generally written as if
-those new intrinsics never existed, but to be changed to use them
-by inserting @code{INTRINSIC} statements in the appropriate places.
-However, it should be the goal of development to use @code{EXTERNAL}
-for all names of external procedures that might be intrinsic names.
-
-If an intrinsic is in more than one group, it is enabled if any of its
-containing groups are enabled; if not so enabled, it is hidden if
-any of its containing groups are hidden; if not so hidden, it is disabled
-if any of its containing groups are disabled; if not so disabled, it is
-deleted.
-This extra complication is necessary because some intrinsics,
-such as @code{IBITS}, belong to more than one group, and hence should be
-enabled if any of the groups to which they belong are enabled, and so
-on.
-
-The groups are:
-
-@cindex intrinsics, groups of
-@cindex groups of intrinsics
-@table @code
-@cindex @code{badu77} intrinsics group
-@item badu77
-UNIX intrinsics having inappropriate forms (usually functions that
-have intended side effects).
-
-@cindex @code{gnu} intrinsics group
-@item gnu
-Intrinsics the GNU Fortran language supports that are extensions to
-the Fortran standards (77 and 90).
-
-@cindex @command{f2c} intrinsics group
-@item f2c
-Intrinsics supported by AT&T's @command{f2c} converter and/or @code{libf2c}.
-
-@cindex @code{f90} intrinsics group
-@item f90
-Fortran 90 intrinsics.
-
-@cindex @code{mil} intrinsics group
-@item mil
-MIL-STD 1753 intrinsics (@code{MVBITS}, @code{IAND}, @code{BTEST}, and so on).
-
-@cindex @code{mil} intrinsics group
-@item unix
-UNIX intrinsics (@code{IARGC}, @code{EXIT}, @code{ERF}, and so on).
-
-@cindex @code{mil} intrinsics group
-@item vxt
-VAX/VMS FORTRAN (current as of v4) intrinsics.
-@end table
-
-@node Other Intrinsics
-@subsection Other Intrinsics
-@cindex intrinsics, others
-@cindex other intrinsics
-
-@command{g77} supports intrinsics other than those in the GNU Fortran
-language proper.
-This set of intrinsics is described below.
-
-@ifinfo
-(Note that the empty lines appearing in the menu below
-are not intentional---they result from a bug in the
-@code{makeinfo} program.)
-@end ifinfo
-
-@c The actual documentation for intrinsics comes from
-@c intdoc.texi, which in turn is automatically generated
-@c from the internal g77 tables in intrin.def _and_ the
-@c largely hand-written text in intdoc.h.  So, if you want
-@c to change or add to existing documentation on intrinsics,
-@c you probably want to edit intdoc.h.
-@c
-@clear familyF77
-@clear familyGNU
-@clear familyASC
-@clear familyMIL
-@clear familyF90
-@set familyVXT
-@set familyFVZ
-@clear familyF2C
-@clear familyF2U
-@set familyBADU77
-@include intdoc.texi
-
-@node Other Compilers
-@chapter Other Compilers
-
-An individual Fortran source file can be compiled to
-an object (@file{*.o}) file instead of to the final
-program executable.
-This allows several portions of a program to be compiled
-at different times and linked together whenever a new
-version of the program is needed.
-However, it introduces the issue of @dfn{object compatibility}
-across the various object files (and libraries, or @file{*.a}
-files) that are linked together to produce any particular
-executable file.
-
-Object compatibility is an issue when combining, in one
-program, Fortran code compiled by more than one compiler
-(or more than one configuration of a compiler).
-If the compilers
-disagree on how to transform the names of procedures, there
-will normally be errors when linking such programs.
-Worse, if the compilers agree on naming, but disagree on issues
-like how to pass parameters, return arguments, and lay out
-@code{COMMON} areas, the earliest detected errors might be the
-incorrect results produced by the program (and that assumes
-these errors are detected, which is not always the case).
-
-Normally, @command{g77} generates code that is
-object-compatible with code generated by a version of
-@command{f2c} configured (with, for example, @file{f2c.h} definitions)
-to be generally compatible with @command{g77} as built by @command{gcc}.
-(Normally, @command{f2c} will, by default, conform to the appropriate
-configuration, but it is possible that older or perhaps even newer
-versions of @command{f2c}, or versions having certain configuration changes
-to @command{f2c} internals, will produce object files that are
-incompatible with @command{g77}.)
-
-For example, a Fortran string subroutine
-argument will become two arguments on the C side: a @code{char *}
-and an @code{int} length.
-
-Much of this compatibility results from the fact that
-@command{g77} uses the same run-time library,
-@code{libf2c}, used by @command{f2c},
-though @command{g77} gives its version the name @code{libg2c}
-so as to avoid conflicts when linking,
-installing them in the same directories,
-and so on.
-
-Other compilers might or might not generate code that
-is object-compatible with @code{libg2c} and current @command{g77},
-and some might offer such compatibility only when explicitly
-selected via a command-line option to the compiler.
-
-@emph{Note: This portion of the documentation definitely needs a lot
-of work!}
-
-@menu
-* Dropping f2c Compatibility::  When speed is more important.
-* Compilers Other Than f2c::    Interoperation with code from other compilers.
-@end menu
-
-@node Dropping f2c Compatibility
-@section Dropping @command{f2c} Compatibility
-
-Specifying @option{-fno-f2c} allows @command{g77} to generate, in
-some cases, faster code, by not needing to allow to the possibility
-of linking with code compiled by @command{f2c}.
-
-For example, this affects how @code{REAL(KIND=1)},
-@code{COMPLEX(KIND=1)}, and @code{COMPLEX(KIND=2)} functions are called.
-With @option{-fno-f2c}, they are
-compiled as returning the appropriate @command{gcc} type
-(@code{float}, @code{__complex__ float}, @code{__complex__ double},
-in many configurations).
-
-With @option{-ff2c} in force, they
-are compiled differently (with perhaps slower run-time performance)
-to accommodate the restrictions inherent in @command{f2c}'s use of K&R
-C as an intermediate language---@code{REAL(KIND=1)} functions
-return C's @code{double} type, while @code{COMPLEX} functions return
-@code{void} and use an extra argument pointing to a place for the functions to
-return their values.
-
-It is possible that, in some cases, leaving @option{-ff2c} in force
-might produce faster code than using @option{-fno-f2c}.
-Feel free to experiment, but remember to experiment with changing the way
-@emph{entire programs and their Fortran libraries are compiled} at
-a time, since this sort of experimentation affects the interface
-of code generated for a Fortran source file---that is, it affects
-object compatibility.
-
-Note that @command{f2c} compatibility is a fairly static target to achieve,
-though not necessarily perfectly so, since, like @command{g77}, it is
-still being improved.
-However, specifying @option{-fno-f2c} causes @command{g77}
-to generate code that will probably be incompatible with code
-generated by future versions of @command{g77} when the same option
-is in force.
-You should make sure you are always able to recompile complete
-programs from source code when upgrading to new versions of @command{g77}
-or @command{f2c}, especially when using options such as @option{-fno-f2c}.
-
-Therefore, if you are using @command{g77} to compile libraries and other
-object files for possible future use and you don't want to require
-recompilation for future use with subsequent versions of @command{g77},
-you might want to stick with @command{f2c} compatibility for now, and
-carefully watch for any announcements about changes to the
-@command{f2c}/@code{libf2c} interface that might affect existing programs
-(thus requiring recompilation).
-
-It is probable that a future version of @command{g77} will not,
-by default, generate object files compatible with @command{f2c},
-and that version probably would no longer use @code{libf2c}.
-If you expect to depend on this compatibility in the
-long term, use the options @samp{-ff2c -ff2c-library} when compiling
-all of the applicable code.
-This should cause future versions of @command{g77} either to produce
-compatible code (at the expense of the availability of some features and
-performance), or at the very least, to produce diagnostics.
-
-(The library @command{g77} produces will no longer be named @file{libg2c}
-when it is no longer generally compatible with @file{libf2c}.
-It will likely be referred to, and, if installed as a distinct
-library, named @code{libg77}, or some other as-yet-unused name.)
-
-@node Compilers Other Than f2c
-@section Compilers Other Than @command{f2c}
-
-On systems with Fortran compilers other than @command{f2c} and @command{g77},
-code compiled by @command{g77} is not expected to work
-well with code compiled by the native compiler.
-(This is true for @command{f2c}-compiled objects as well.)
-Libraries compiled with the native compiler probably will have
-to be recompiled with @command{g77} to be used with @command{g77}-compiled code.
-
-Reasons for such incompatibilities include:
-
-@itemize @bullet
-@item
-There might be differences in the way names of Fortran procedures
-are translated for use in the system's object-file format.
-For example, the statement @samp{CALL FOO} might be compiled
-by @command{g77} to call a procedure the linker @command{ld} sees
-given the name @samp{_foo_}, while the apparently corresponding
-statement @samp{SUBROUTINE FOO} might be compiled by the
-native compiler to define the linker-visible name @samp{_foo},
-or @samp{_FOO_}, and so on.
-
-@item
-There might be subtle type mismatches which cause subroutine arguments
-and function return values to get corrupted.
-
-This is why simply getting @command{g77} to
-transform procedure names the same way a native
-compiler does is not usually a good idea---unless
-some effort has been made to ensure that, aside
-from the way the two compilers transform procedure
-names, everything else about the way they generate
-code for procedure interfaces is identical.
-
-@item
-Native compilers
-use libraries of private I/O routines which will not be available
-at link time unless you have the native compiler---and you would
-have to explicitly ask for them.
-
-For example, on the Sun you
-would have to add @samp{-L/usr/lang/SCx.x -lF77 -lV77} to the link
-command.
-@end itemize
-
-@node Other Languages
-@chapter Other Languages
-
-@emph{Note: This portion of the documentation definitely needs a lot
-of work!}
-
-@menu
-* Interoperating with C and C++::
-@end menu
-
-@node Interoperating with C and C++
-@section Tools and advice for interoperating with C and C++
-
-@cindex C, linking with
-@cindex C++, linking with
-@cindex linking with C
-The following discussion assumes that you are running @command{g77} in @command{f2c}
-compatibility mode, i.e.@: not using @option{-fno-f2c}.
-It provides some
-advice about quick and simple techniques for linking Fortran and C (or
-C++), the most common requirement.
-For the full story consult the
-description of code generation.
-@xref{Debugging and Interfacing}.
-
-When linking Fortran and C, it's usually best to use @command{g77} to do
-the linking so that the correct libraries are included (including the
-maths one).
-If you're linking with C++ you will want to add
-@option{-lstdc++}, @option{-lg++} or whatever.
-If you need to use another
-driver program (or @command{ld} directly),
-you can find out what linkage
-options @command{g77} passes by running @samp{g77 -v}.
-
-@menu
-* C Interfacing Tools::
-* C Access to Type Information::
-* f2c Skeletons and Prototypes::
-* C++ Considerations::
-* Startup Code::
-@end menu
-
-@node C Interfacing Tools
-@subsection C Interfacing Tools
-@pindex f2c
-@cindex cfortran.h
-@cindex Netlib
-Even if you don't actually use it as a compiler, @command{f2c} from
-@uref{ftp://ftp.netlib.org/f2c/src}, can be a useful tool when you're
-interfacing (linking) Fortran and C@.
-@xref{f2c Skeletons and Prototypes,,Generating Skeletons and Prototypes with @command{f2c}}.
-
-To use @command{f2c} for this purpose you only need retrieve and
-build the @file{src} directory from the distribution, consult the
-@file{README} instructions there for machine-specifics, and install the
-@command{f2c} program on your path.
-
-Something else that might be useful is @samp{cfortran.h} from
-@uref{ftp://zebra.desy.de/cfortran}.
-This is a fairly general tool which
-can be used to generate interfaces for calling in both directions
-between Fortran and C@.
-It can be used in @command{f2c} mode with
-@command{g77}---consult its documentation for details.
-
-@node C Access to Type Information
-@subsection Accessing Type Information in C
-
-@cindex types, Fortran/C
-Generally, C code written to link with
-@command{g77} code---calling and/or being
-called from Fortran---should @samp{#include <g2c.h>} to define the C
-versions of the Fortran types.
-Don't assume Fortran @code{INTEGER} types
-correspond to C @code{int}s, for instance; instead, declare them as
-@code{integer}, a type defined by @file{g2c.h}.
-@file{g2c.h} is installed where @command{gcc} will find it by
-default, assuming you use a copy of @command{gcc} compatible with
-@command{g77}, probably built at the same time as @command{g77}.
-
-@node f2c Skeletons and Prototypes
-@subsection Generating Skeletons and Prototypes with @command{f2c}
-
-@pindex f2c
-@cindex -fno-second-underscore
-A simple and foolproof way to write @command{g77}-callable C routines---e.g.@: to
-interface with an existing library---is to write a file (named, for
-example, @file{fred.f}) of dummy Fortran
-skeletons comprising just the declaration of the routine(s) and dummy
-arguments plus @code{END} statements.
-Then run @command{f2c} on file @file{fred.f} to produce @file{fred.c}
-into which you can edit
-useful code, confident the calling sequence is correct, at least.
-(There are some errors otherwise commonly made in generating C
-interfaces with @command{f2c} conventions,
-such as not using @code{doublereal}
-as the return type of a @code{REAL} @code{FUNCTION}.)
-
-@pindex ftnchek
-@command{f2c} also can help with calling Fortran from C, using its
-@option{-P} option to generate C prototypes appropriate for calling the
-Fortran.@footnote{The files generated like this can also be used for
-inter-unit consistency checking of dummy and actual arguments, although
-the @command{ftnchek} tool from @uref{ftp://ftp.netlib.org/fortran}
-or @uref{ftp://ftp.dsm.fordham.edu} is
-probably better for this purpose.}
-If the Fortran code containing any
-routines to be called from C is in file @file{joe.f}, use the command
-@kbd{f2c -P joe.f} to generate the file @file{joe.P} containing
-prototype information.
-@code{#include} this in the C which has to call
-the Fortran routines to make sure you get it right.
-
-@xref{Arrays,,Arrays (DIMENSION)}, for information on the differences
-between the way Fortran (including compilers like @command{g77}) and
-C handle arrays.
-
-@node C++ Considerations
-@subsection C++ Considerations
-
-@cindex C++
-@command{f2c} can be used to generate suitable code for compilation with a
-C++ system using the @option{-C++} option.
-The important thing about linking @command{g77}-compiled
-code with C++ is that the prototypes for the @command{g77}
-routines must specify C linkage to avoid name mangling.
-So, use an @samp{extern "C"} declaration.
-@command{f2c}'s @option{-C++} option will not take care
-of this when generating skeletons or prototype files as above, however,
-it will avoid clashes with C++ reserved words in addition to those in C@.
-
-@node Startup Code
-@subsection Startup Code
-
-@cindex startup code
-@cindex run-time, initialization
-@cindex initialization, run-time
-Unlike with some runtime systems,
-it shouldn't be necessary
-(unless there are bugs)
-to use a Fortran main program unit to ensure the
-runtime---specifically the I/O system---is initialized.
-
-However, to use the @command{g77} intrinsics @code{GETARG} and @code{IARGC},
-either the @code{main} routine from the @file{libg2c} library must be used,
-or the @code{f_setarg} routine
-(new as of @code{egcs} version 1.1 and @command{g77} version 0.5.23)
-must be called with the appropriate @code{argc} and @code{argv} arguments
-prior to the program calling @code{GETARG} or @code{IARGC}.
-
-To provide more flexibility for mixed-language programming
-involving @command{g77} while allowing for shared libraries,
-as of @code{egcs} version 1.1 and @command{g77} version 0.5.23,
-@command{g77}'s @code{main} routine in @code{libg2c}
-does the following, in order:
-
-@enumerate
-@item
-Calls @code{f_setarg}
-with the incoming @code{argc} and @code{argv} arguments,
-in the same order as for @code{main} itself.
-
-This sets up the command-line environment
-for @code{GETARG} and @code{IARGC}.
-
-@item
-Calls @code{f_setsig} (with no arguments).
-
-This sets up the signaling and exception environment.
-
-@item
-Calls @code{f_init} (with no arguments).
-
-This initializes the I/O environment,
-though that should not be necessary,
-as all I/O functions in @code{libf2c}
-are believed to call @code{f_init} automatically,
-if necessary.
-
-(A future version of @command{g77} might skip this explicit step,
-to speed up normal exit of a program.)
-
-@item
-Arranges for @code{f_exit} to be called (with no arguments)
-when the program exits.
-
-This ensures that the I/O environment is properly shut down
-before the program exits normally.
-Otherwise, output buffers might not be fully flushed,
-scratch files might not be deleted, and so on.
-
-The simple way @code{main} does this is
-to call @code{f_exit} itself after calling
-@code{MAIN__} (in the next step).
-
-However, this does not catch the cases where the program
-might call @code{exit} directly,
-instead of using the @code{EXIT} intrinsic
-(implemented as @code{exit_} in @code{libf2c}).
-
-So, @code{main} attempts to use
-the operating environment's @code{onexit} or @code{atexit}
-facility, if available,
-to cause @code{f_exit} to be called automatically
-upon any invocation of @code{exit}.
-
-@item
-Calls @code{MAIN__} (with no arguments).
-
-This starts executing the Fortran main program unit for
-the application.
-(Both @command{g77} and @command{f2c} currently compile a main
-program unit so that its global name is @code{MAIN__}.)
-
-@item
-If no @code{onexit} or @code{atexit} is provided by the system,
-calls @code{f_exit}.
-
-@item
-Calls @code{exit} with a zero argument,
-to signal a successful program termination.
-
-@item
-Returns a zero value to the caller,
-to signal a successful program termination,
-in case @code{exit} doesn't exit on the system.
-@end enumerate
-
-All of the above names are C @code{extern} names,
-i.e.@: not mangled.
-
-When using the @code{main} procedure provided by @command{g77}
-without a Fortran main program unit,
-you need to provide @code{MAIN__}
-as the entry point for your C code.
-(Make sure you link the object file that defines that
-entry point with the rest of your program.)
-
-To provide your own @code{main} procedure
-in place of @command{g77}'s,
-make sure you specify the object file defining that procedure
-@emph{before} @option{-lg2c} on the @command{g77} command line.
-Since the @option{-lg2c} option is implicitly provided,
-this is usually straightforward.
-(Use the @option{--verbose} option to see how and where
-@command{g77} implicitly adds @option{-lg2c} in a command line
-that will link the program.
-Feel free to specify @option{-lg2c} explicitly,
-as appropriate.)
-
-However, when providing your own @code{main},
-make sure you perform the appropriate tasks in the
-appropriate order.
-For example, if your @code{main} does not call @code{f_setarg},
-make sure the rest of your application does not call
-@code{GETARG} or @code{IARGC}.
-
-And, if your @code{main} fails to ensure that @code{f_exit}
-is called upon program exit,
-some files might end up incompletely written,
-some scratch files might be left lying around,
-and some existing files being written might be left
-with old data not properly truncated at the end.
-
-Note that, generally, the @command{g77} operating environment
-does not depend on a procedure named @code{MAIN__} actually
-being called prior to any other @command{g77}-compiled code.
-That is, @code{MAIN__} does not, itself,
-set up any important operating-environment characteristics
-upon which other code might depend.
-This might change in future versions of @command{g77},
-with appropriate notification in the release notes.
-
-For more information, consult the source code for the above routines.
-These are in @file{@value{path-libf2c}/libF77/}, named @file{main.c},
-@file{setarg.c}, @file{setsig.c}, @file{getarg_.c}, and @file{iargc_.c}.
-
-Also, the file @file{@value{path-g77}/com.c} contains the code @command{g77}
-uses to open-code (inline) references to @code{IARGC}.
-
-@node Debugging and Interfacing
-@chapter Debugging and Interfacing
-@cindex debugging
-@cindex interfacing
-@cindex calling C routines
-@cindex C routines calling Fortran
-@cindex f2c compatibility
-
-GNU Fortran currently generates code that is object-compatible with
-the @command{f2c} converter.
-Also, it avoids limitations in the current GBE, such as the
-inability to generate a procedure with
-multiple entry points, by generating code that is structured
-differently (in terms of procedure names, scopes, arguments, and
-so on) than might be expected.
-
-As a result, writing code in other languages that calls on, is
-called by, or shares in-memory data with @command{g77}-compiled code generally
-requires some understanding of the way @command{g77} compiles code for
-various constructs.
-
-Similarly, using a debugger to debug @command{g77}-compiled
-code, even if that debugger supports native Fortran debugging, generally
-requires this sort of information.
-
-This section describes some of the basic information on how
-@command{g77} compiles code for constructs involving interfaces to other
-languages and to debuggers.
-
-@emph{Caution:} Much or all of this information pertains to only the current
-release of @command{g77}, sometimes even to using certain compiler options
-with @command{g77} (such as @option{-fno-f2c}).
-Do not write code that depends on this
-information without clearly marking said code as nonportable and
-subject to review for every new release of @command{g77}.
-This information
-is provided primarily to make debugging of code generated by this
-particular release of @command{g77} easier for the user, and partly to make
-writing (generally nonportable) interface code easier.
-Both of these
-activities require tracking changes in new version of @command{g77} as they
-are installed, because new versions can change the behaviors
-described in this section.
-
-@menu
-* Main Program Unit::  How @command{g77} compiles a main program unit.
-* Procedures::         How @command{g77} constructs parameter lists
-                       for procedures.
-* Functions::          Functions returning floating-point or character data.
-* Names::              Naming of user-defined variables, procedures, etc.
-* Common Blocks::      Accessing common variables while debugging.
-* Local Equivalence Areas::  Accessing @code{EQUIVALENCE} while debugging.
-* Complex Variables::  How @command{g77} performs complex arithmetic.
-* Arrays::             Dealing with (possibly multi-dimensional) arrays.
-* Adjustable Arrays::  Special consideration for adjustable arrays.
-* Alternate Entry Points::  How @command{g77} implements alternate @code{ENTRY}.
-* Alternate Returns::  How @command{g77} handles alternate returns.
-* Assigned Statement Labels::  How @command{g77} handles @code{ASSIGN}.
-* Run-time Library Errors::  Meanings of some @code{IOSTAT=} values.
-@end menu
-
-@node Main Program Unit
-@section Main Program Unit (PROGRAM)
-@cindex PROGRAM statement
-@cindex statements, PROGRAM
-
-When @command{g77} compiles a main program unit, it gives it the public
-procedure name @code{MAIN__}.
-The @code{libg2c} library has the actual @code{main()} procedure
-as is typical of C-based environments, and
-it is this procedure that performs some initial start-up
-activity and then calls @code{MAIN__}.
-
-Generally, @command{g77} and @code{libg2c} are designed so that you need not
-include a main program unit written in Fortran in your program---it
-can be written in C or some other language.
-Especially for I/O handling, this is the case, although @command{g77} version 0.5.16
-includes a bug fix for @code{libg2c} that solved a problem with using the
-@code{OPEN} statement as the first Fortran I/O activity in a program
-without a Fortran main program unit.
-
-However, if you don't intend to use @command{g77} (or @command{f2c}) to compile
-your main program unit---that is, if you intend to compile a @code{main()}
-procedure using some other language---you should carefully
-examine the code for @code{main()} in @code{libg2c}, found in the source
-file @file{@value{path-libf2c}/libF77/main.c}, to see what kinds of things
-might need to be done by your @code{main()} in order to provide the
-Fortran environment your Fortran code is expecting.
-
-@cindex @code{IArgC} intrinsic
-@cindex intrinsics, @code{IArgC}
-@cindex @code{GetArg} intrinsic
-@cindex intrinsics, @code{GetArg}
-For example, @code{libg2c}'s @code{main()} sets up the information used by
-the @code{IARGC} and @code{GETARG} intrinsics.
-Bypassing @code{libg2c}'s @code{main()}
-without providing a substitute for this activity would mean
-that invoking @code{IARGC} and @code{GETARG} would produce undefined
-results.
-
-@cindex debugging
-@cindex main program unit, debugging
-@cindex main()
-@cindex MAIN__()
-@cindex .gdbinit
-When debugging, one implication of the fact that @code{main()}, which
-is the place where the debugged program ``starts'' from the
-debugger's point of view, is in @code{libg2c} is that you won't be
-starting your Fortran program at a point you recognize as your
-Fortran code.
-
-The standard way to get around this problem is to set a break
-point (a one-time, or temporary, break point will do) at
-the entrance to @code{MAIN__}, and then run the program.
-A convenient way to do so is to add the @command{gdb} command
-
-@example
-tbreak MAIN__
-@end example
-
-@noindent
-to the file @file{.gdbinit} in the directory in which you're debugging
-(using @command{gdb}).
-
-After doing this, the debugger will see the current execution
-point of the program as at the beginning of the main program
-unit of your program.
-
-Of course, if you really want to set a break point at some
-other place in your program and just start the program
-running, without first breaking at @code{MAIN__},
-that should work fine.
-
-@node Procedures
-@section Procedures (SUBROUTINE and FUNCTION)
-@cindex procedures
-@cindex SUBROUTINE statement
-@cindex statements, SUBROUTINE
-@cindex FUNCTION statement
-@cindex statements, FUNCTION
-@cindex signature of procedures
-
-Currently, @command{g77} passes arguments via reference---specifically,
-by passing a pointer to the location in memory of a variable, array,
-array element, a temporary location that holds the result of evaluating an
-expression, or a temporary or permanent location that holds the value
-of a constant.
-
-Procedures that accept @code{CHARACTER} arguments are implemented by
-@command{g77} so that each @code{CHARACTER} argument has two actual arguments.
-
-The first argument occupies the expected position in the
-argument list and has the user-specified name.
-This argument
-is a pointer to an array of characters, passed by the caller.
-
-The second argument is appended to the end of the user-specified
-calling sequence and is named @samp{__g77_length_@var{x}}, where @var{x}
-is the user-specified name.
-This argument is of the C type @code{ftnlen}
-(see @file{@value{path-libf2c}/g2c.h.in} for information on that type) and
-is the number of characters the caller has allocated in the
-array pointed to by the first argument.
-
-A procedure will ignore the length argument if @samp{X} is not declared
-@code{CHARACTER*(*)}, because for other declarations, it knows the
-length.
-Not all callers necessarily ``know'' this, however, which
-is why they all pass the extra argument.
-
-The contents of the @code{CHARACTER} argument are specified by the
-address passed in the first argument (named after it).
-The procedure can read or write these contents as appropriate.
-
-When more than one @code{CHARACTER} argument is present in the argument
-list, the length arguments are appended in the order
-the original arguments appear.
-So @samp{CALL FOO('HI','THERE')} is implemented in
-C as @samp{foo("hi","there",2,5);}, ignoring the fact that @command{g77}
-does not provide the trailing null bytes on the constant
-strings (@command{f2c} does provide them, but they are unnecessary in
-a Fortran environment, and you should not expect them to be
-there).
-
-Note that the above information applies to @code{CHARACTER} variables and
-arrays @strong{only}.
-It does @strong{not} apply to external @code{CHARACTER}
-functions or to intrinsic @code{CHARACTER} functions.
-That is, no second length argument is passed to @samp{FOO} in this case:
-
-@example
-CHARACTER X
-EXTERNAL X
-CALL FOO(X)
-@end example
-
-@noindent
-Nor does @samp{FOO} expect such an argument in this case:
-
-@example
-SUBROUTINE FOO(X)
-CHARACTER X
-EXTERNAL X
-@end example
-
-Because of this implementation detail, if a program has a bug
-such that there is disagreement as to whether an argument is
-a procedure, and the type of the argument is @code{CHARACTER}, subtle
-symptoms might appear.
-
-@node Functions
-@section Functions (FUNCTION and RETURN)
-@cindex functions
-@cindex FUNCTION statement
-@cindex statements, FUNCTION
-@cindex RETURN statement
-@cindex statements, RETURN
-@cindex return type of functions
-
-@command{g77} handles in a special way functions that return the following
-types:
-
-@itemize @bullet
-@item
-@code{CHARACTER}
-@item
-@code{COMPLEX}
-@item
-@code{REAL(KIND=1)}
-@end itemize
-
-For @code{CHARACTER}, @command{g77} implements a subroutine (a C function
-returning @code{void})
-with two arguments prepended: @samp{__g77_result}, which the caller passes
-as a pointer to a @code{char} array expected to hold the return value,
-and @samp{__g77_length}, which the caller passes as an @code{ftnlen} value
-specifying the length of the return value as declared in the calling
-program.
-For @code{CHARACTER*(*)}, the called function uses @samp{__g77_length}
-to determine the size of the array that @samp{__g77_result} points to;
-otherwise, it ignores that argument.
-
-For @code{COMPLEX}, when @option{-ff2c} is in
-force, @command{g77} implements
-a subroutine with one argument prepended: @samp{__g77_result}, which the
-caller passes as a pointer to a variable of the type of the function.
-The called function writes the return value into this variable instead
-of returning it as a function value.
-When @option{-fno-f2c} is in force,
-@command{g77} implements a @code{COMPLEX} function as @command{gcc}'s
-@samp{__complex__ float} or @samp{__complex__ double} function
-(or an emulation thereof, when @option{-femulate-complex} is in effect),
-returning the result of the function in the same way as @command{gcc} would.
-
-For @code{REAL(KIND=1)}, when @option{-ff2c} is in force, @command{g77} implements
-a function that actually returns @code{REAL(KIND=2)} (typically
-C's @code{double} type).
-When @option{-fno-f2c} is in force, @code{REAL(KIND=1)}
-functions return @code{float}.
-
-@node Names
-@section Names
-@cindex symbol names
-@cindex transforming symbol names
-
-Fortran permits each implementation to decide how to represent
-names as far as how they're seen in other contexts, such as debuggers
-and when interfacing to other languages, and especially as far
-as how casing is handled.
-
-External names---names of entities that are public, or ``accessible'',
-to all modules in a program---normally have an underscore (@samp{_})
-appended by @command{g77},
-to generate code that is compatible with @command{f2c}.
-External names include names of Fortran things like common blocks,
-external procedures (subroutines and functions, but not including
-statement functions, which are internal procedures), and entry point
-names.
-
-However, use of the @option{-fno-underscoring} option
-disables this kind of transformation of external names (though inhibiting
-the transformation certainly improves the chances of colliding with
-incompatible externals written in other languages---but that
-might be intentional.
-
-@cindex -fno-underscoring option
-@cindex options, -fno-underscoring
-@cindex -fno-second-underscore option
-@cindex options, -fno-underscoring
-When @option{-funderscoring} is in force, any name (external or local)
-that already has at least one underscore in it is
-implemented by @command{g77} by appending two underscores.
-(This second underscore can be disabled via the
-@option{-fno-second-underscore} option.)
-External names are changed this way for @command{f2c} compatibility.
-Local names are changed this way to avoid collisions with external names
-that are different in the source code---@command{f2c} does the same thing, but
-there's no compatibility issue there except for user expectations while
-debugging.
-
-For example:
-
-@example
-Max_Cost = 0
-@end example
-
-@cindex debugging
-@noindent
-Here, a user would, in the debugger, refer to this variable using the
-name @samp{max_cost__} (or @samp{MAX_COST__} or @samp{Max_Cost__},
-as described below).
-(We hope to improve @command{g77} in this regard in the future---don't
-write scripts depending on this behavior!
-Also, consider experimenting with the @option{-fno-underscoring}
-option to try out debugging without having to massage names by
-hand like this.)
-
-@command{g77} provides a number of command-line options that allow the user
-to control how case mapping is handled for source files.
-The default is the traditional UNIX model for Fortran compilers---names
-are mapped to lower case.
-Other command-line options can be specified to map names to upper
-case, or to leave them exactly as written in the source file.
-
-For example:
-
-@example
-Foo = 9.436
-@end example
-
-@noindent
-Here, it is normally the case that the variable assigned will be named
-@samp{foo}.
-This would be the name to enter when using a debugger to
-access the variable.
-
-However, depending on the command-line options specified, the
-name implemented by @command{g77} might instead be @samp{FOO} or even
-@samp{Foo}, thus affecting how debugging is done.
-
-Also:
-
-@example
-Call Foo
-@end example
-
-@noindent
-This would normally call a procedure that, if it were in a separate C program,
-be defined starting with the line:
-
-@example
-void foo_()
-@end example
-
-@noindent
-However, @command{g77} command-line options could be used to change the casing
-of names, resulting in the name @samp{FOO_} or @samp{Foo_} being given to the
-procedure instead of @samp{foo_}, and the @option{-fno-underscoring} option
-could be used to inhibit the appending of the underscore to the name.
-
-@node Common Blocks
-@section Common Blocks (COMMON)
-@cindex common blocks
-@cindex @code{COMMON} statement
-@cindex statements, @code{COMMON}
-
-@command{g77} names and lays out @code{COMMON} areas
-the same way @command{f2c} does,
-for compatibility with @command{f2c}.
-
-@node Local Equivalence Areas
-@section Local Equivalence Areas (EQUIVALENCE)
-@cindex equivalence areas
-@cindex local equivalence areas
-@cindex EQUIVALENCE statement
-@cindex statements, EQUIVALENCE
-
-@command{g77} treats storage-associated areas involving a @code{COMMON}
-block as explained in the section on common blocks.
-
-A local @code{EQUIVALENCE} area is a collection of variables and arrays
-connected to each other in any way via @code{EQUIVALENCE}, none of which are
-listed in a @code{COMMON} statement.
-
-(@emph{Note:} @command{g77} version 0.5.18 and earlier chose the name
-for @var{x} using a different method when more than one name was
-in the list of names of entities placed at the beginning of the
-array.
-Though the documentation specified that the first name listed in
-the @code{EQUIVALENCE} statements was chosen for @var{x}, @command{g77}
-in fact chose the name using a method that was so complicated,
-it seemed easier to change it to an alphabetical sort than to describe the
-previous method in the documentation.)
-
-@node Complex Variables
-@section Complex Variables (COMPLEX)
-@cindex complex variables
-@cindex imaginary part
-@cindex COMPLEX statement
-@cindex statements, COMPLEX
-
-As of 0.5.20, @command{g77} defaults to handling @code{COMPLEX} types
-(and related intrinsics, constants, functions, and so on)
-in a manner that
-makes direct debugging involving these types in Fortran
-language mode difficult.
-
-Essentially, @command{g77} implements these types using an
-internal construct similar to C's @code{struct}, at least
-as seen by the @command{gcc} back end.
-
-Currently, the back end, when outputting debugging info with
-the compiled code for the assembler to digest, does not detect
-these @code{struct} types as being substitutes for Fortran
-complex.
-As a result, the Fortran language modes of debuggers such as
-@command{gdb} see these types as C @code{struct} types, which
-they might or might not support.
-
-Until this is fixed, switch to C language mode to work with
-entities of @code{COMPLEX} type and then switch back to Fortran language
-mode afterward.
-(In @command{gdb}, this is accomplished via @samp{set lang c} and
-either @samp{set lang fortran} or @samp{set lang auto}.)
-
-@node Arrays
-@section Arrays (DIMENSION)
-@cindex DIMENSION statement
-@cindex statements, DIMENSION
-@cindex array ordering
-@cindex ordering, array
-@cindex column-major ordering
-@cindex row-major ordering
-@cindex arrays
-
-Fortran uses ``column-major ordering'' in its arrays.
-This differs from other languages, such as C, which use ``row-major ordering''.
-The difference is that, with Fortran, array elements adjacent to
-each other in memory differ in the @emph{first} subscript instead of
-the last; @samp{A(5,10,20)} immediately follows @samp{A(4,10,20)},
-whereas with row-major ordering it would follow @samp{A(5,10,19)}.
-
-This consideration
-affects not only interfacing with and debugging Fortran code,
-it can greatly affect how code is designed and written, especially
-when code speed and size is a concern.
-
-Fortran also differs from C, a popular language for interfacing and
-to support directly in debuggers, in the way arrays are treated.
-In C, arrays are single-dimensional and have interesting relationships
-to pointers, neither of which is true for Fortran.
-As a result, dealing with Fortran arrays from within
-an environment limited to C concepts can be challenging.
-
-For example, accessing the array element @samp{A(5,10,20)} is easy enough
-in Fortran (use @samp{A(5,10,20)}), but in C some difficult machinations
-are needed.
-First, C would treat the A array as a single-dimension array.
-Second, C does not understand low bounds for arrays as does Fortran.
-Third, C assumes a low bound of zero (0), while Fortran defaults to a
-low bound of one (1) and can supports an arbitrary low bound.
-Therefore, calculations must be done
-to determine what the C equivalent of @samp{A(5,10,20)} would be, and these
-calculations require knowing the dimensions of @samp{A}.
-
-For @samp{DIMENSION A(2:11,21,0:29)}, the calculation of the offset of
-@samp{A(5,10,20)} would be:
-
-@example
-  (5-2)
-+ (10-1)*(11-2+1)
-+ (20-0)*(11-2+1)*(21-1+1)
-= 4293
-@end example
-
-@noindent
-So the C equivalent in this case would be @samp{a[4293]}.
-
-When using a debugger directly on Fortran code, the C equivalent
-might not work, because some debuggers cannot understand the notion
-of low bounds other than zero.  However, unlike @command{f2c}, @command{g77}
-does inform the GBE that a multi-dimensional array (like @samp{A}
-in the above example) is really multi-dimensional, rather than a
-single-dimensional array, so at least the dimensionality of the array
-is preserved.
-
-Debuggers that understand Fortran should have no trouble with
-nonzero low bounds, but for non-Fortran debuggers, especially
-C debuggers, the above example might have a C equivalent of
-@samp{a[4305]}.
-This calculation is arrived at by eliminating the subtraction
-of the lower bound in the first parenthesized expression on each
-line---that is, for @samp{(5-2)} substitute @samp{(5)}, for @samp{(10-1)}
-substitute @samp{(10)}, and for @samp{(20-0)} substitute @samp{(20)}.
-Actually, the implication of
-this can be that the expression @samp{*(&a[2][1][0] + 4293)} works fine,
-but that @samp{a[20][10][5]} produces the equivalent of
-@samp{*(&a[0][0][0] + 4305)} because of the missing lower bounds.
-
-Come to think of it, perhaps
-the behavior is due to the debugger internally compensating for
-the lower bounds by offsetting the base address of @samp{a}, leaving
-@samp{&a} set lower, in this case, than @samp{&a[2][1][0]} (the address of
-its first element as identified by subscripts equal to the
-corresponding lower bounds).
-
-You know, maybe nobody really needs to use arrays.
-
-@node Adjustable Arrays
-@section Adjustable Arrays (DIMENSION)
-@cindex arrays, adjustable
-@cindex adjustable arrays
-@cindex arrays, automatic
-@cindex automatic arrays
-@cindex DIMENSION statement
-@cindex statements, DIMENSION
-@cindex dimensioning arrays
-@cindex arrays, dimensioning
-
-Adjustable and automatic arrays in Fortran require the implementation
-(in this
-case, the @command{g77} compiler) to ``memorize'' the expressions that
-dimension the arrays each time the procedure is invoked.
-This is so that subsequent changes to variables used in those
-expressions, made during execution of the procedure, do not
-have any effect on the dimensions of those arrays.
-
-For example:
-
-@example
-REAL ARRAY(5)
-DATA ARRAY/5*2/
-CALL X(ARRAY, 5)
-END
-SUBROUTINE X(A, N)
-DIMENSION A(N)
-N = 20
-PRINT *, N, A
-END
-@end example
-
-@noindent
-Here, the implementation should, when running the program, print something
-like:
-
-@example
-20   2.  2.  2.  2.  2.
-@end example
-
-@noindent
-Note that this shows that while the value of @samp{N} was successfully
-changed, the size of the @samp{A} array remained at 5 elements.
-
-To support this, @command{g77} generates code that executes before any user
-code (and before the internally generated computed @code{GOTO} to handle
-alternate entry points, as described below) that evaluates each
-(nonconstant) expression in the list of subscripts for an
-array, and saves the result of each such evaluation to be used when
-determining the size of the array (instead of re-evaluating the
-expressions).
-
-So, in the above example, when @samp{X} is first invoked, code is
-executed that copies the value of @samp{N} to a temporary.
-And that same temporary serves as the actual high bound for the single
-dimension of the @samp{A} array (the low bound being the constant 1).
-Since the user program cannot (legitimately) change the value
-of the temporary during execution of the procedure, the size
-of the array remains constant during each invocation.
-
-For alternate entry points, the code @command{g77} generates takes into
-account the possibility that a dummy adjustable array is not actually
-passed to the actual entry point being invoked at that time.
-In that case, the public procedure implementing the entry point
-passes to the master private procedure implementing all the
-code for the entry points a @code{NULL} pointer where a pointer to that
-adjustable array would be expected.
-The @command{g77}-generated code
-doesn't attempt to evaluate any of the expressions in the subscripts
-for an array if the pointer to that array is @code{NULL} at run time in
-such cases.
-(Don't depend on this particular implementation
-by writing code that purposely passes @code{NULL} pointers where the
-callee expects adjustable arrays, even if you know the callee
-won't reference the arrays---nor should you pass @code{NULL} pointers
-for any dummy arguments used in calculating the bounds of such
-arrays or leave undefined any values used for that purpose in
-COMMON---because the way @command{g77} implements these things might
-change in the future!)
-
-@node Alternate Entry Points
-@section Alternate Entry Points (ENTRY)
-@cindex alternate entry points
-@cindex entry points
-@cindex ENTRY statement
-@cindex statements, ENTRY
-
-The GBE does not understand the general concept of
-alternate entry points as Fortran provides via the ENTRY statement.
-@command{g77} gets around this by using an approach to compiling procedures
-having at least one @code{ENTRY} statement that is almost identical to the
-approach used by @command{f2c}.
-(An alternate approach could be used that
-would probably generate faster, but larger, code that would also
-be a bit easier to debug.)
-
-Information on how @command{g77} implements @code{ENTRY} is provided for those
-trying to debug such code.
-The choice of implementation seems
-unlikely to affect code (compiled in other languages) that interfaces
-to such code.
-
-@command{g77} compiles exactly one public procedure for the primary entry
-point of a procedure plus each @code{ENTRY} point it specifies, as usual.
-That is, in terms of the public interface, there is no difference
-between
-
-@example
-SUBROUTINE X
-END
-SUBROUTINE Y
-END
-@end example
-
-@noindent
-and:
-
-@example
-SUBROUTINE X
-ENTRY Y
-END
-@end example
-
-The difference between the above two cases lies in the code compiled
-for the @samp{X} and @samp{Y} procedures themselves, plus the fact that,
-for the second case, an extra internal procedure is compiled.
-
-For every Fortran procedure with at least one @code{ENTRY}
-statement, @command{g77} compiles an extra procedure
-named @samp{__g77_masterfun_@var{x}}, where @var{x} is
-the name of the primary entry point (which, in the above case,
-using the standard compiler options, would be @samp{x_} in C).
-
-This extra procedure is compiled as a private procedure---that is,
-a procedure not accessible by name to separately compiled modules.
-It contains all the code in the program unit, including the code
-for the primary entry point plus for every entry point.
-(The code for each public procedure is quite short, and explained later.)
-
-The extra procedure has some other interesting characteristics.
-
-The argument list for this procedure is invented by @command{g77}.
-It contains
-a single integer argument named @samp{__g77_which_entrypoint},
-passed by value (as in Fortran's @samp{%VAL()} intrinsic), specifying the
-entry point index---0 for the primary entry point, 1 for the
-first entry point (the first @code{ENTRY} statement encountered), 2 for
-the second entry point, and so on.
-
-It also contains, for functions returning @code{CHARACTER} and
-(when @option{-ff2c} is in effect) @code{COMPLEX} functions,
-and for functions returning different types among the
-@code{ENTRY} statements (e.g. @samp{REAL FUNCTION R()}
-containing @samp{ENTRY I()}), an argument named @samp{__g77_result} that
-is expected at run time to contain a pointer to where to store
-the result of the entry point.
-For @code{CHARACTER} functions, this
-storage area is an array of the appropriate number of characters;
-for @code{COMPLEX} functions, it is the appropriate area for the return
-type; for multiple-return-type functions, it is a union of all the supported return
-types (which cannot include @code{CHARACTER}, since combining @code{CHARACTER}
-and non-@code{CHARACTER} return types via @code{ENTRY} in a single function
-is not supported by @command{g77}).
-
-For @code{CHARACTER} functions, the @samp{__g77_result} argument is followed
-by yet another argument named @samp{__g77_length} that, at run time,
-specifies the caller's expected length of the returned value.
-Note that only @code{CHARACTER*(*)} functions and entry points actually
-make use of this argument, even though it is always passed by
-all callers of public @code{CHARACTER} functions (since the caller does not
-generally know whether such a function is @code{CHARACTER*(*)} or whether
-there are any other callers that don't have that information).
-
-The rest of the argument list is the union of all the arguments
-specified for all the entry points (in their usual forms, e.g.
-@code{CHARACTER} arguments have extra length arguments, all appended at
-the end of this list).
-This is considered the ``master list'' of
-arguments.
-
-The code for this procedure has, before the code for the first
-executable statement, code much like that for the following Fortran
-statement:
-
-@smallexample
-       GOTO (100000,100001,100002), __g77_which_entrypoint
-100000 @dots{}code for primary entry point@dots{}
-100001 @dots{}code immediately following first ENTRY statement@dots{}
-100002 @dots{}code immediately following second ENTRY statement@dots{}
-@end smallexample
-
-@noindent
-(Note that invalid Fortran statement labels and variable names
-are used in the above example to highlight the fact that it
-represents code generated by the @command{g77} internals, not code to be
-written by the user.)
-
-It is this code that, when the procedure is called, picks which
-entry point to start executing.
-
-Getting back to the public procedures (@samp{x} and @samp{Y} in the original
-example), those procedures are fairly simple.
-Their interfaces
-are just like they would be if they were self-contained procedures
-(without @code{ENTRY}), of course, since that is what the callers
-expect.
-Their code consists of simply calling the private
-procedure, described above, with the appropriate extra arguments
-(the entry point index, and perhaps a pointer to a multiple-type-
-return variable, local to the public procedure, that contains
-all the supported returnable non-character types).
-For arguments
-that are not listed for a given entry point that are listed for
-other entry points, and therefore that are in the ``master list''
-for the private procedure, null pointers (in C, the @code{NULL} macro)
-are passed.
-Also, for entry points that are part of a multiple-type-
-returning function, code is compiled after the call of the private
-procedure to extract from the multi-type union the appropriate result,
-depending on the type of the entry point in question, returning
-that result to the original caller.
-
-When debugging a procedure containing alternate entry points, you
-can either set a break point on the public procedure itself (e.g.
-a break point on @samp{X} or @samp{Y}) or on the private procedure that
-contains most of the pertinent code (e.g. @samp{__g77_masterfun_@var{x}}).
-If you do the former, you should use the debugger's command to
-``step into'' the called procedure to get to the actual code; with
-the latter approach, the break point leaves you right at the
-actual code, skipping over the public entry point and its call
-to the private procedure (unless you have set a break point there
-as well, of course).
-
-Further, the list of dummy arguments that is visible when the
-private procedure is active is going to be the expanded version
-of the list for whichever particular entry point is active,
-as explained above, and the way in which return values are
-handled might well be different from how they would be handled
-for an equivalent single-entry function.
-
-@node Alternate Returns
-@section Alternate Returns (SUBROUTINE and RETURN)
-@cindex subroutines
-@cindex alternate returns
-@cindex SUBROUTINE statement
-@cindex statements, SUBROUTINE
-@cindex RETURN statement
-@cindex statements, RETURN
-
-Subroutines with alternate returns (e.g. @samp{SUBROUTINE X(*)} and
-@samp{CALL X(*50)}) are implemented by @command{g77} as functions returning
-the C @code{int} type.
-The actual alternate-return arguments are omitted from the calling sequence.
-Instead, the caller uses
-the return value to do a rough equivalent of the Fortran
-computed-@code{GOTO} statement, as in @samp{GOTO (50), X()} in the
-example above (where @samp{X} is quietly declared as an @code{INTEGER(KIND=1)}
-function), and the callee just returns whatever integer
-is specified in the @code{RETURN} statement for the subroutine
-For example, @samp{RETURN 1} is implemented as @samp{X = 1} followed
-by @samp{RETURN}
-in C, and @samp{RETURN} by itself is @samp{X = 0} and @samp{RETURN}).
-
-@node Assigned Statement Labels
-@section Assigned Statement Labels (ASSIGN and GOTO)
-@cindex assigned statement labels
-@cindex statement labels, assigned
-@cindex ASSIGN statement
-@cindex statements, ASSIGN
-@cindex GOTO statement
-@cindex statements, GOTO
-
-For portability to machines where a pointer (such as to a label,
-which is how @command{g77} implements @code{ASSIGN} and its relatives,
-the assigned-@code{GOTO} and assigned-@code{FORMAT}-I/O statements)
-is wider (bitwise) than an @code{INTEGER(KIND=1)}, @command{g77}
-uses a different memory location to hold the @code{ASSIGN}ed value of a variable
-than it does the numerical value in that variable, unless the
-variable is wide enough (can hold enough bits).
-
-In particular, while @command{g77} implements
-
-@example
-I = 10
-@end example
-
-@noindent
-as, in C notation, @samp{i = 10;}, it implements
-
-@example
-ASSIGN 10 TO I
-@end example
-
-@noindent
-as, in GNU's extended C notation (for the label syntax),
-@samp{__g77_ASSIGN_I = &&L10;} (where @samp{L10} is just a massaging
-of the Fortran label @samp{10} to make the syntax C-like; @command{g77} doesn't
-actually generate the name @samp{L10} or any other name like that,
-since debuggers cannot access labels anyway).
-
-While this currently means that an @code{ASSIGN} statement does not
-overwrite the numeric contents of its target variable, @emph{do not}
-write any code depending on this feature.
-@command{g77} has already changed this implementation across
-versions and might do so in the future.
-This information is provided only to make debugging Fortran programs
-compiled with the current version of @command{g77} somewhat easier.
-If there's no debugger-visible variable named @samp{__g77_ASSIGN_I}
-in a program unit that does @samp{ASSIGN 10 TO I}, that probably
-means @command{g77} has decided it can store the pointer to the label directly
-into @samp{I} itself.
-
-@xref{Ugly Assigned Labels}, for information on a command-line option
-to force @command{g77} to use the same storage for both normal and
-assigned-label uses of a variable.
-
-@node Run-time Library Errors
-@section Run-time Library Errors
-@cindex IOSTAT=
-@cindex error values
-@cindex error messages
-@cindex messages, run-time
-@cindex I/O, errors
-
-The @code{libg2c} library currently has the following table to relate
-error code numbers, returned in @code{IOSTAT=} variables, to messages.
-This information should, in future versions of this document, be
-expanded upon to include detailed descriptions of each message.
-
-In line with good coding practices, any of the numbers in the
-list below should @emph{not} be directly written into Fortran
-code you write.
-Instead, make a separate @code{INCLUDE} file that defines
-@code{PARAMETER} names for them, and use those in your code,
-so you can more easily change the actual numbers in the future.
-
-The information below is culled from the definition
-of @code{F_err} in @file{f/runtime/libI77/err.c} in the
-@command{g77} source tree.
-
-@smallexample
-100: "error in format"
-101: "illegal unit number"
-102: "formatted io not allowed"
-103: "unformatted io not allowed"
-104: "direct io not allowed"
-105: "sequential io not allowed"
-106: "can't backspace file"
-107: "null file name"
-108: "can't stat file"
-109: "unit not connected"
-110: "off end of record"
-111: "truncation failed in endfile"
-112: "incomprehensible list input"
-113: "out of free space"
-114: "unit not connected"
-115: "read unexpected character"
-116: "bad logical input field"
-117: "bad variable type"
-118: "bad namelist name"
-119: "variable not in namelist"
-120: "no end record"
-121: "variable count incorrect"
-122: "subscript for scalar variable"
-123: "invalid array section"
-124: "substring out of bounds"
-125: "subscript out of bounds"
-126: "can't read file"
-127: "can't write file"
-128: "'new' file exists"
-129: "can't append to file"
-130: "non-positive record number"
-131: "I/O started while already doing I/O"
-@end smallexample
-
-@node Collected Fortran Wisdom
-@chapter Collected Fortran Wisdom
-@cindex wisdom
-@cindex legacy code
-@cindex code, legacy
-@cindex writing code
-@cindex code, writing
-
-Most users of @command{g77} can be divided into two camps:
-
-@itemize @bullet
-@item
-Those writing new Fortran code to be compiled by @command{g77}.
-
-@item
-Those using @command{g77} to compile existing, ``legacy'' code.
-@end itemize
-
-Users writing new code generally understand most of the necessary
-aspects of Fortran to write ``mainstream'' code, but often need
-help deciding how to handle problems, such as the construction
-of libraries containing @code{BLOCK DATA}.
-
-Users dealing with ``legacy'' code sometimes don't have much
-experience with Fortran, but believe that the code they're compiling
-already works when compiled by other compilers (and might
-not understand why, as is sometimes the case, it doesn't work
-when compiled by @command{g77}).
-
-The following information is designed to help users do a better job
-coping with existing, ``legacy'' Fortran code, and with writing
-new code as well.
-
-@menu
-* Advantages Over f2c::        If @command{f2c} is so great, why @command{g77}?
-* Block Data and Libraries::   How @command{g77} solves a common problem.
-* Loops::                      Fortran @code{DO} loops surprise many people.
-* Working Programs::           Getting programs to work should be done first.
-* Overly Convenient Options::  Temptations to avoid, habits to not form.
-* Faster Programs::            Everybody wants these, but at what cost?
-@end menu
-
-@node Advantages Over f2c
-@section Advantages Over f2c
-
-Without @command{f2c}, @command{g77} would have taken much longer to
-do and probably not been as good for quite a while.
-Sometimes people who notice how much @command{g77} depends on, and
-documents encouragement to use, @command{f2c} ask why @command{g77}
-was created if @command{f2c} already existed.
-
-This section gives some basic answers to these questions, though it
-is not intended to be comprehensive.
-
-@menu
-* Language Extensions::  Features used by Fortran code.
-* Diagnostic Abilities:: Abilities to spot problems early.
-* Compiler Options::     Features helpful to accommodate legacy code, etc.
-* Compiler Speed::       Speed of the compilation process.
-* Program Speed::        Speed of the generated, optimized code.
-* Ease of Debugging::    Debugging ease-of-use at the source level.
-* Character and Hollerith Constants::  A byte saved is a byte earned.
-@end menu
-
-@node Language Extensions
-@subsection Language Extensions
-
-@command{g77} offers several extensions to FORTRAN 77 language that @command{f2c}
-doesn't:
-
-@itemize @bullet
-@item
-Automatic arrays
-
-@item
-@code{CYCLE} and @code{EXIT}
-
-@item
-Construct names
-
-@item
-@code{SELECT CASE}
-
-@item
-@code{KIND=} and @code{LEN=} notation
-
-@item
-Semicolon as statement separator
-
-@item
-Constant expressions in @code{FORMAT} statements
-(such as @samp{FORMAT(I<J>)},
-where @samp{J} is a @code{PARAMETER} named constant)
-
-@item
-@code{MvBits} intrinsic
-
-@item
-@code{libU77} (Unix-compatibility) library,
-with routines known to compiler as intrinsics
-(so they work even when compiler options are used
-to change the interfaces used by Fortran routines)
-@end itemize
-
-@command{g77} also implements iterative @code{DO} loops
-so that they work even in the presence of certain ``extreme'' inputs,
-unlike @command{f2c}.
-@xref{Loops}.
-
-However, @command{f2c} offers a few that @command{g77} doesn't, such as:
-
-@itemize @bullet
-@item
-Intrinsics in @code{PARAMETER} statements
-
-@item
-Array bounds expressions (such as @samp{REAL M(N(2))})
-
-@item
-@code{AUTOMATIC} statement
-@end itemize
-
-It is expected that @command{g77} will offer some or all of these missing
-features at some time in the future.
-
-@node Diagnostic Abilities
-@subsection Diagnostic Abilities
-
-@command{g77} offers better diagnosis of problems in @code{FORMAT} statements.
-@command{f2c} doesn't, for example, emit any diagnostic for
-@samp{FORMAT(XZFAJG10324)},
-leaving that to be diagnosed, at run time, by
-the @code{libf2c} run-time library.
-
-@node Compiler Options
-@subsection Compiler Options
-
-@command{g77} offers compiler options that @command{f2c} doesn't,
-most of which are designed to more easily accommodate
-legacy code:
-
-@itemize @bullet
-@item
-Two that control the automatic appending of extra
-underscores to external names
-
-@item
-One that allows dollar signs (@samp{$}) in symbol names
-
-@item
-A variety that control acceptance of various
-``ugly'' constructs
-
-@item
-Several that specify acceptable use of upper and lower case
-in the source code
-
-@item
-Many that enable, disable, delete, or hide
-groups of intrinsics
-
-@item
-One to specify the length of fixed-form source lines
-(normally 72)
-
-@item
-One to specify the the source code is written in
-Fortran-90-style free-form
-@end itemize
-
-However, @command{f2c} offers a few that @command{g77} doesn't,
-like an option to have @code{REAL} default to @code{REAL*8}.
-It is expected that @command{g77} will offer all of the
-missing options pertinent to being a Fortran compiler
-at some time in the future.
-
-@node Compiler Speed
-@subsection Compiler Speed
-
-Saving the steps of writing and then rereading C code is a big reason
-why @command{g77} should be able to compile code much faster than using
-@command{f2c} in conjunction with the equivalent invocation of @command{gcc}.
-
-However, due to @command{g77}'s youth, lots of self-checking is still being
-performed.
-As a result, this improvement is as yet unrealized
-(though the potential seems to be there for quite a big speedup
-in the future).
-It is possible that, as of version 0.5.18, @command{g77}
-is noticeably faster compiling many Fortran source files than using
-@command{f2c} in conjunction with @command{gcc}.
-
-@node Program Speed
-@subsection Program Speed
-
-@command{g77} has the potential to better optimize code than @command{f2c},
-even when @command{gcc} is used to compile the output of @command{f2c},
-because @command{f2c} must necessarily
-translate Fortran into a somewhat lower-level language (C) that cannot
-preserve all the information that is potentially useful for optimization,
-while @command{g77} can gather, preserve, and transmit that information directly
-to the GBE.
-
-For example, @command{g77} implements @code{ASSIGN} and assigned
-@code{GOTO} using direct assignment of pointers to labels and direct
-jumps to labels, whereas @command{f2c} maps the assigned labels to
-integer values and then uses a C @code{switch} statement to encode
-the assigned @code{GOTO} statements.
-
-However, as is typical, theory and reality don't quite match, at least
-not in all cases, so it is still the case that @command{f2c} plus @command{gcc}
-can generate code that is faster than @command{g77}.
-
-Version 0.5.18 of @command{g77} offered default
-settings and options, via patches to the @command{gcc}
-back end, that allow for better program speed, though
-some of these improvements also affected the performance
-of programs translated by @command{f2c} and then compiled
-by @command{g77}'s version of @command{gcc}.
-
-Version 0.5.20 of @command{g77} offers further performance
-improvements, at least one of which (alias analysis) is
-not generally applicable to @command{f2c} (though @command{f2c}
-could presumably be changed to also take advantage of
-this new capability of the @command{gcc} back end, assuming
-this is made available in an upcoming release of @command{gcc}).
-
-@node Ease of Debugging
-@subsection Ease of Debugging
-
-Because @command{g77} compiles directly to assembler code like @command{gcc},
-instead of translating to an intermediate language (C) as does @command{f2c},
-support for debugging can be better for @command{g77} than @command{f2c}.
-
-However, although @command{g77} might be somewhat more ``native'' in terms of
-debugging support than @command{f2c} plus @command{gcc}, there still are a lot
-of things ``not quite right''.
-Many of the important ones should be resolved in the near future.
-
-For example, @command{g77} doesn't have to worry about reserved names
-like @command{f2c} does.
-Given @samp{FOR = WHILE}, @command{f2c} must necessarily
-translate this to something @emph{other} than
-@samp{for = while;}, because C reserves those words.
-
-However, @command{g77} does still uses things like an extra level of indirection
-for @code{ENTRY}-laden procedures---in this case, because the back end doesn't
-yet support multiple entry points.
-
-Another example is that, given
-
-@smallexample
-COMMON A, B
-EQUIVALENCE (B, C)
-@end smallexample
-
-@noindent
-the @command{g77} user should be able to access the variables directly, by name,
-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).
-
-Yet another example is arrays.
-@command{g77} represents them to the debugger
-using the same ``dimensionality'' as in the source code, while @command{f2c}
-must necessarily convert them all to one-dimensional arrays to fit
-into the confines of the C language.
-However, the level of support
-offered by debuggers for interactive Fortran-style access to arrays
-as compiled by @command{g77} can vary widely.
-In some cases, it can actually
-be an advantage that @command{f2c} converts everything to widely supported
-C semantics.
-
-In fairness, @command{g77} could do many of the things @command{f2c} does
-to get things working at least as well as @command{f2c}---for now,
-the developers prefer making @command{g77} work the
-way they think it is supposed to, and finding help improving the
-other products (the back end of @command{gcc}; @command{gdb}; and so on)
-to get things working properly.
-
-@node Character and Hollerith Constants
-@subsection Character and Hollerith Constants
-@cindex character constants
-@cindex constants, character
-@cindex Hollerith constants
-@cindex constants, Hollerith
-@cindex trailing null byte
-@cindex null byte, trailing
-@cindex zero byte, trailing
-
-To avoid the extensive hassle that would be needed to avoid this,
-@command{f2c} uses C character constants to encode character and Hollerith
-constants.
-That means a constant like @samp{'HELLO'} is translated to
-@samp{"hello"} in C, which further means that an extra null byte is
-present at the end of the constant.
-This null byte is superfluous.
-
-@command{g77} does not generate such null bytes.
-This represents significant
-savings of resources, such as on systems where @file{/dev/null} or
-@file{/dev/zero} represent bottlenecks in the systems' performance,
-because @command{g77} simply asks for fewer zeros from the operating
-system than @command{f2c}.
-(Avoiding spurious use of zero bytes, each byte typically have
-eight zero bits, also reduces the liabilities in case
-Microsoft's rumored patent on the digits 0 and 1 is upheld.)
-
-@node Block Data and Libraries
-@section Block Data and Libraries
-@cindex block data and libraries
-@cindex BLOCK DATA statement
-@cindex statements, BLOCK DATA
-@cindex libraries, containing BLOCK DATA
-@cindex f2c compatibility
-@cindex compatibility, f2c
-
-To ensure that block data program units are linked, especially a concern
-when they are put into libraries, give each one a name (as in
-@samp{BLOCK DATA FOO}) and make sure there is an @samp{EXTERNAL FOO}
-statement in every program unit that uses any common block
-initialized by the corresponding @code{BLOCK DATA}.
-@command{g77} currently compiles a @code{BLOCK DATA} as if it were a
-@code{SUBROUTINE},
-that is, it generates an actual procedure having the appropriate name.
-The procedure does nothing but return immediately if it happens to be
-called.
-For @samp{EXTERNAL FOO}, where @samp{FOO} is not otherwise referenced in the
-same program unit, @command{g77} assumes there exists a @samp{BLOCK DATA FOO}
-in the program and ensures that by generating a
-reference to it so the linker will make sure it is present.
-(Specifically, @command{g77} outputs in the data section a static pointer to the
-external name @samp{FOO}.)
-
-The implementation @command{g77} currently uses to make this work is
-one of the few things not compatible with @command{f2c} as currently
-shipped.
-@command{f2c} currently does nothing with @samp{EXTERNAL FOO} except
-issue a warning that @samp{FOO} is not otherwise referenced,
-and, for @samp{BLOCK DATA FOO},
-@command{f2c} doesn't generate a dummy procedure with the name @samp{FOO}.
-The upshot is that you shouldn't mix @command{f2c} and @command{g77} in
-this particular case.
-If you use @command{f2c} to compile @samp{BLOCK DATA FOO},
-then any @command{g77}-compiled program unit that says @samp{EXTERNAL FOO}
-will result in an unresolved reference when linked.
-If you do the
-opposite, then @samp{FOO} might not be linked in under various
-circumstances (such as when @samp{FOO} is in a library, or you're
-using a ``clever'' linker---so clever, it produces a broken program
-with little or no warning by omitting initializations of global data
-because they are contained in unreferenced procedures).
-
-The changes you make to your code to make @command{g77} handle this situation,
-however, appear to be a widely portable way to handle it.
-That is, many systems permit it (as they should, since the
-FORTRAN 77 standard permits @samp{EXTERNAL FOO} when @samp{FOO}
-is a block data program unit), and of the ones
-that might not link @samp{BLOCK DATA FOO} under some circumstances, most of
-them appear to do so once @samp{EXTERNAL FOO} is present in the appropriate
-program units.
-
-Here is the recommended approach to modifying a program containing
-a program unit such as the following:
-
-@smallexample
-BLOCK DATA FOO
-COMMON /VARS/ X, Y, Z
-DATA X, Y, Z / 3., 4., 5. /
-END
-@end smallexample
-
-@noindent
-If the above program unit might be placed in a library module, then
-ensure that every program unit in every program that references that
-particular @code{COMMON} area uses the @code{EXTERNAL} statement
-to force the area to be initialized.
-
-For example, change a program unit that starts with
-
-@smallexample
-INTEGER FUNCTION CURX()
-COMMON /VARS/ X, Y, Z
-CURX = X
-END
-@end smallexample
-
-@noindent
-so that it uses the @code{EXTERNAL} statement, as in:
-
-@smallexample
-INTEGER FUNCTION CURX()
-COMMON /VARS/ X, Y, Z
-EXTERNAL FOO
-CURX = X
-END
-@end smallexample
-
-@noindent
-That way, @samp{CURX} is compiled by @command{g77} (and many other
-compilers) so that the linker knows it must include @samp{FOO},
-the @code{BLOCK DATA} program unit that sets the initial values
-for the variables in @samp{VAR}, in the executable program.
-
-@node Loops
-@section Loops
-@cindex DO statement
-@cindex statements, DO
-@cindex trips, number of
-@cindex number of trips
-
-The meaning of a @code{DO} loop in Fortran is precisely specified
-in the Fortran standard@dots{}and is quite different from what
-many programmers might expect.
-
-In particular, Fortran iterative @code{DO} loops are implemented as if
-the number of trips through the loop is calculated @emph{before}
-the loop is entered.
-
-The number of trips for a loop is calculated from the @var{start},
-@var{end}, and @var{increment} values specified in a statement such as:
-
-@smallexample
-DO @var{iter} = @var{start}, @var{end}, @var{increment}
-@end smallexample
-
-@noindent
-The trip count is evaluated using a fairly simple formula
-based on the three values following the @samp{=} in the
-statement, and it is that trip count that is effectively
-decremented during each iteration of the loop.
-If, at the beginning of an iteration of the loop, the
-trip count is zero or negative, the loop terminates.
-The per-loop-iteration modifications to @var{iter} are not
-related to determining whether to terminate the loop.
-
-There are two important things to remember about the trip
-count:
-
-@itemize @bullet
-@item
-It can be @emph{negative}, in which case it is
-treated as if it was zero---meaning the loop is
-not executed at all.
-
-@item
-The type used to @emph{calculate} the trip count
-is the same type as @var{iter}, but the final
-calculation, and thus the type of the trip
-count itself, always is @code{INTEGER(KIND=1)}.
-@end itemize
-
-These two items mean that there are loops that cannot
-be written in straightforward fashion using the Fortran @code{DO}.
-
-For example, on a system with the canonical 32-bit two's-complement
-implementation of @code{INTEGER(KIND=1)}, the following loop will not work:
-
-@smallexample
-DO I = -2000000000, 2000000000
-@end smallexample
-
-@noindent
-Although the @var{start} and @var{end} values are well within
-the range of @code{INTEGER(KIND=1)}, the @emph{trip count} is not.
-The expected trip count is 40000000001, which is outside
-the range of @code{INTEGER(KIND=1)} on many systems.
-
-Instead, the above loop should be constructed this way:
-
-@smallexample
-I = -2000000000
-DO
-  IF (I .GT. 2000000000) EXIT
-  @dots{}
-  I = I + 1
-END DO
-@end smallexample
-
-@noindent
-The simple @code{DO} construct and the @code{EXIT} statement
-(used to leave the innermost loop)
-are F90 features that @command{g77} supports.
-
-Some Fortran compilers have buggy implementations of @code{DO},
-in that they don't follow the standard.
-They implement @code{DO} as a straightforward translation
-to what, in C, would be a @code{for} statement.
-Instead of creating a temporary variable to hold the trip count
-as calculated at run time, these compilers
-use the iteration variable @var{iter} to control
-whether the loop continues at each iteration.
-
-The bug in such an implementation shows up when the
-trip count is within the range of the type of @var{iter},
-but the magnitude of @samp{ABS(@var{end}) + ABS(@var{incr})}
-exceeds that range.  For example:
-
-@smallexample
-DO I = 2147483600, 2147483647
-@end smallexample
-
-@noindent
-A loop started by the above statement will work as implemented
-by @command{g77}, but the use, by some compilers, of a
-more C-like implementation akin to
-
-@smallexample
-for (i = 2147483600; i <= 2147483647; ++i)
-@end smallexample
-
-@noindent
-produces a loop that does not terminate, because @samp{i}
-can never be greater than 2147483647, since incrementing it
-beyond that value overflows @samp{i}, setting it to -2147483648.
-This is a large, negative number that still is less than 2147483647.
-
-Another example of unexpected behavior of @code{DO} involves
-using a nonintegral iteration variable @var{iter}, that is,
-a @code{REAL} variable.
-Consider the following program:
-
-@smallexample
-      DATA BEGIN, END, STEP /.1, .31, .007/
-      DO 10 R = BEGIN, END, STEP
-         IF (R .GT. END) PRINT *, R, ' .GT. ', END, '!!'
-         PRINT *,R
-10    CONTINUE
-      PRINT *,'LAST = ',R
-      IF (R .LE. END) PRINT *, R, ' .LE. ', END, '!!'
-      END
-@end smallexample
-
-@noindent
-A C-like view of @code{DO} would hold that the two ``exclamatory''
-@code{PRINT} statements are never executed.
-However, this is the output of running the above program
-as compiled by @command{g77} on a GNU/Linux ix86 system:
-
-@smallexample
- .100000001
- .107000001
- .114
- .120999999
- @dots{}
- .289000005
- .296000004
- .303000003
-LAST =   .310000002
- .310000002 .LE.   .310000002!!
-@end smallexample
-
-Note that one of the two checks in the program turned up
-an apparent violation of the programmer's expectation---yet,
-the loop is correctly implemented by @command{g77}, in that
-it has 30 iterations.
-This trip count of 30 is correct when evaluated using
-the floating-point representations for the @var{begin},
-@var{end}, and @var{incr} values (.1, .31, .007) on GNU/Linux
-ix86 are used.
-On other systems, an apparently more accurate trip count
-of 31 might result, but, nevertheless, @command{g77} is
-faithfully following the Fortran standard, and the result
-is not what the author of the sample program above
-apparently expected.
-(Such other systems might, for different values in the @code{DATA}
-statement, violate the other programmer's expectation,
-for example.)
-
-Due to this combination of imprecise representation
-of floating-point values and the often-misunderstood
-interpretation of @code{DO} by standard-conforming
-compilers such as @command{g77}, use of @code{DO} loops
-with @code{REAL} iteration
-variables is not recommended.
-Such use can be caught by specifying @option{-Wsurprising}.
-@xref{Warning Options}, for more information on this
-option.
-
-@node Working Programs
-@section Working Programs
-
-Getting Fortran programs to work in the first place can be
-quite a challenge---even when the programs already work on
-other systems, or when using other compilers.
-
-@command{g77} offers some facilities that might be useful for
-tracking down bugs in such programs.
-
-@menu
-* Not My Type::
-* Variables Assumed To Be Zero::
-* Variables Assumed To Be Saved::
-* Unwanted Variables::
-* Unused Arguments::
-* Surprising Interpretations of Code::
-* Aliasing Assumed To Work::
-* Output Assumed To Flush::
-* Large File Unit Numbers::
-* Floating-point precision::
-* Inconsistent Calling Sequences::
-@end menu
-
-@node Not My Type
-@subsection Not My Type
-@cindex mistyped variables
-@cindex variables, mistyped
-@cindex mistyped functions
-@cindex functions, mistyped
-@cindex implicit typing
-
-A fruitful source of bugs in Fortran source code is use, or
-mis-use, of Fortran's implicit-typing feature, whereby the
-type of a variable, array, or function is determined by the
-first character of its name.
-
-Simple cases of this include statements like @samp{LOGX=9.227},
-without a statement such as @samp{REAL LOGX}.
-In this case, @samp{LOGX} is implicitly given @code{INTEGER(KIND=1)}
-type, with the result of the assignment being that it is given
-the value @samp{9}.
-
-More involved cases include a function that is defined starting
-with a statement like @samp{DOUBLE PRECISION FUNCTION IPS(@dots{})}.
-Any caller of this function that does not also declare @samp{IPS}
-as type @code{DOUBLE PRECISION} (or, in GNU Fortran, @code{REAL(KIND=2)})
-is likely to assume it returns
-@code{INTEGER}, or some other type, leading to invalid results
-or even program crashes.
-
-The @option{-Wimplicit} option might catch failures to
-properly specify the types of
-variables, arrays, and functions in the code.
-
-However, in code that makes heavy use of Fortran's
-implicit-typing facility, this option might produce so
-many warnings about cases that are working, it would be
-hard to find the one or two that represent bugs.
-This is why so many experienced Fortran programmers strongly
-recommend widespread use of the @code{IMPLICIT NONE} statement,
-despite it not being standard FORTRAN 77, to completely turn
-off implicit typing.
-(@command{g77} supports @code{IMPLICIT NONE}, as do almost all
-FORTRAN 77 compilers.)
-
-Note that @option{-Wimplicit} catches only implicit typing of
-@emph{names}.
-It does not catch implicit typing of expressions such
-as @samp{X**(2/3)}.
-Such expressions can be buggy as well---in fact, @samp{X**(2/3)}
-is equivalent to @samp{X**0}, due to the way Fortran expressions
-are given types and then evaluated.
-(In this particular case, the programmer probably wanted
-@samp{X**(2./3.)}.)
-
-@node Variables Assumed To Be Zero
-@subsection Variables Assumed To Be Zero
-@cindex zero-initialized variables
-@cindex variables, assumed to be zero
-@cindex uninitialized variables
-
-Many Fortran programs were developed on systems that provided
-automatic initialization of all, or some, variables and arrays
-to zero.
-As a result, many of these programs depend, sometimes
-inadvertently, on this behavior, though to do so violates
-the Fortran standards.
-
-You can ask @command{g77} for this behavior by specifying the
-@option{-finit-local-zero} option when compiling Fortran code.
-(You might want to specify @option{-fno-automatic} as well,
-to avoid code-size inflation for non-optimized compilations.)
-
-Note that a program that works better when compiled with the
-@option{-finit-local-zero} option
-is almost certainly depending on a particular system's,
-or compiler's, tendency to initialize some variables to zero.
-It might be worthwhile finding such cases and fixing them,
-using techniques such as compiling with the @option{-O -Wuninitialized}
-options using @command{g77}.
-
-@node Variables Assumed To Be Saved
-@subsection Variables Assumed To Be Saved
-@cindex variables, retaining values across calls
-@cindex saved variables
-@cindex static variables
-
-Many Fortran programs were developed on systems that
-saved the values of all, or some, variables and arrays
-across procedure calls.
-As a result, many of these programs depend, sometimes
-inadvertently, on being able to assign a value to a
-variable, perform a @code{RETURN} to a calling procedure,
-and, upon subsequent invocation, reference the previously
-assigned variable to obtain the value.
-
-They expect this despite not using the @code{SAVE} statement
-to specify that the value in a variable is expected to survive
-procedure returns and calls.
-Depending on variables and arrays to retain values across
-procedure calls without using @code{SAVE} to require it violates
-the Fortran standards.
-
-You can ask @command{g77} to assume @code{SAVE} is specified for all
-relevant (local) variables and arrays by using the
-@option{-fno-automatic} option.
-
-Note that a program that works better when compiled with the
-@option{-fno-automatic} option
-is almost certainly depending on not having to use
-the @code{SAVE} statement as required by the Fortran standard.
-It might be worthwhile finding such cases and fixing them,
-using techniques such as compiling with the @samp{-O -Wuninitialized}
-options using @command{g77}.
-
-@node Unwanted Variables
-@subsection Unwanted Variables
-
-The @option{-Wunused} option can find bugs involving
-implicit typing, sometimes
-more easily than using @option{-Wimplicit} in code that makes
-heavy use of implicit typing.
-An unused variable or array might indicate that the
-spelling for its declaration is different from that of
-its intended uses.
-
-Other than cases involving typos, unused variables rarely
-indicate actual bugs in a program.
-However, investigating such cases thoroughly has, on occasion,
-led to the discovery of code that had not been completely
-written---where the programmer wrote declarations as needed
-for the whole algorithm, wrote some or even most of the code
-for that algorithm, then got distracted and forgot that the
-job was not complete.
-
-@node Unused Arguments
-@subsection Unused Arguments
-@cindex unused arguments
-@cindex arguments, unused
-
-As with unused variables, It is possible that unused arguments
-to a procedure might indicate a bug.
-Compile with @samp{-W -Wunused} option to catch cases of
-unused arguments.
-
-Note that @option{-W} also enables warnings regarding overflow
-of floating-point constants under certain circumstances.
-
-@node Surprising Interpretations of Code
-@subsection Surprising Interpretations of Code
-
-The @option{-Wsurprising} option can help find bugs involving
-expression evaluation or in
-the way @code{DO} loops with non-integral iteration variables
-are handled.
-Cases found by this option might indicate a difference of
-interpretation between the author of the code involved, and
-a standard-conforming compiler such as @command{g77}.
-Such a difference might produce actual bugs.
-
-In any case, changing the code to explicitly do what the
-programmer might have expected it to do, so @command{g77} and
-other compilers are more likely to follow the programmer's
-expectations, might be worthwhile, especially if such changes
-make the program work better.
-
-@node Aliasing Assumed To Work
-@subsection Aliasing Assumed To Work
-@cindex -falias-check option
-@cindex options, -falias-check
-@cindex -fargument-alias option
-@cindex options, -fargument-alias
-@cindex -fargument-noalias option
-@cindex options, -fargument-noalias
-@cindex -fno-argument-noalias-global option
-@cindex options, -fno-argument-noalias-global
-@cindex aliasing
-@cindex anti-aliasing
-@cindex overlapping arguments
-@cindex overlays
-@cindex association, storage
-@cindex storage association
-@cindex scheduling of reads and writes
-@cindex reads and writes, scheduling
-
-The @option{-falias-check}, @option{-fargument-alias},
-@option{-fargument-noalias},
-and @option{-fno-argument-noalias-global} options,
-introduced in version 0.5.20 and
-@command{g77}'s version 2.7.2.2.f.2 of @command{gcc},
-were withdrawn as of @command{g77} version 0.5.23
-due to their not being supported by @command{gcc} version 2.8.
-
-These options control the assumptions regarding aliasing
-(overlapping) of writes and reads to main memory (core) made
-by the @command{gcc} back end.
-
-The information below still is useful, but applies to
-only those versions of @command{g77} that support the
-alias analysis implied by support for these options.
-
-These options are effective only when compiling with @option{-O}
-(specifying any level other than @option{-O0})
-or with @option{-falias-check}.
-
-The default for Fortran code is @option{-fargument-noalias-global}.
-(The default for C code and code written in other C-based languages
-is @option{-fargument-alias}.
-These defaults apply regardless of whether you use @command{g77} or
-@command{gcc} to compile your code.)
-
-Note that, on some systems, compiling with @option{-fforce-addr} in
-effect can produce more optimal code when the default aliasing
-options are in effect (and when optimization is enabled).
-
-If your program is not working when compiled with optimization,
-it is possible it is violating the Fortran standards (77 and 90)
-by relying on the ability to ``safely'' modify variables and
-arrays that are aliased, via procedure calls, to other variables
-and arrays, without using @code{EQUIVALENCE} to explicitly
-set up this kind of aliasing.
-
-(The FORTRAN 77 standard's prohibition of this sort of
-overlap, generally referred to therein as ``storage
-association'', appears in Sections 15.9.3.6.
-This prohibition allows implementations, such as @command{g77},
-to, for example, implement the passing of procedures and
-even values in @code{COMMON} via copy operations into local,
-perhaps more efficiently accessed temporaries at entry to a
-procedure, and, where appropriate, via copy operations back
-out to their original locations in memory at exit from that
-procedure, without having to take into consideration the
-order in which the local copies are updated by the code,
-among other things.)
-
-To test this hypothesis, try compiling your program with
-the @option{-fargument-alias} option, which causes the
-compiler to revert to assumptions essentially the same as
-made by versions of @command{g77} prior to 0.5.20.
-
-If the program works using this option, that strongly suggests
-that the bug is in your program.
-Finding and fixing the bug(s) should result in a program that
-is more standard-conforming and that can be compiled by @command{g77}
-in a way that results in a faster executable.
-
-(You might want to try compiling with @option{-fargument-noalias},
-a kind of half-way point, to see if the problem is limited to
-aliasing between dummy arguments and @code{COMMON} variables---this
-option assumes that such aliasing is not done, while still allowing
-aliasing among dummy arguments.)
-
-An example of aliasing that is invalid according to the standards
-is shown in the following program, which might @emph{not} produce
-the expected results when executed:
-
-@smallexample
-I = 1
-CALL FOO(I, I)
-PRINT *, I
-END
-
-SUBROUTINE FOO(J, K)
-J = J + K
-K = J * K
-PRINT *, J, K
-END
-@end smallexample
-
-The above program attempts to use the temporary aliasing of the
-@samp{J} and @samp{K} arguments in @samp{FOO} to effect a
-pathological behavior---the simultaneous changing of the values
-of @emph{both} @samp{J} and @samp{K} when either one of them
-is written.
-
-The programmer likely expects the program to print these values:
-
-@example
-2  4
-4
-@end example
-
-However, since the program is not standard-conforming, an
-implementation's behavior when running it is undefined, because
-subroutine @samp{FOO} modifies at least one of the arguments,
-and they are aliased with each other.
-(Even if one of the assignment statements was deleted, the
-program would still violate these rules.
-This kind of on-the-fly aliasing is permitted by the standard
-only when none of the aliased items are defined, or written,
-while the aliasing is in effect.)
-
-As a practical example, an optimizing compiler might schedule
-the @samp{J =} part of the second line of @samp{FOO} @emph{after}
-the reading of @samp{J} and @samp{K} for the @samp{J * K} expression,
-resulting in the following output:
-
-@example
-2  2
-2
-@end example
-
-Essentially, compilers are promised (by the standard and, therefore,
-by programmers who write code they claim to be standard-conforming)
-that if they cannot detect aliasing via static analysis of a single
-program unit's @code{EQUIVALENCE} and @code{COMMON} statements, no
-such aliasing exists.
-In such cases, compilers are free to assume that an assignment to
-one variable will not change the value of another variable, allowing
-it to avoid generating code to re-read the value of the other
-variable, to re-schedule reads and writes, and so on, to produce
-a faster executable.
-
-The same promise holds true for arrays (as seen by the called
-procedure)---an element of one dummy array cannot be aliased
-with, or overlap, any element of another dummy array or be
-in a @code{COMMON} area known to the procedure.
-
-(These restrictions apply only when the procedure defines, or
-writes to, one of the aliased variables or arrays.)
-
-Unfortunately, there is no way to find @emph{all} possible cases of
-violations of the prohibitions against aliasing in Fortran code.
-Static analysis is certainly imperfect, as is run-time analysis,
-since neither can catch all violations.
-(Static analysis can catch all likely violations, and some that
-might never actually happen, while run-time analysis can catch
-only those violations that actually happen during a particular run.
-Neither approach can cope with programs mixing Fortran code with
-routines written in other languages, however.)
-
-Currently, @command{g77} provides neither static nor run-time facilities
-to detect any cases of this problem, although other products might.
-Run-time facilities are more likely to be offered by future
-versions of @command{g77}, though patches improving @command{g77} so that
-it provides either form of detection are welcome.
-
-@node Output Assumed To Flush
-@subsection Output Assumed To Flush
-@cindex ALWAYS_FLUSH
-@cindex synchronous write errors
-@cindex disk full
-@cindex flushing output
-@cindex fflush()
-@cindex I/O, flushing
-@cindex output, flushing
-@cindex writes, flushing
-@cindex NFS
-@cindex network file system
-
-For several versions prior to 0.5.20, @command{g77} configured its
-version of the @code{libf2c} run-time library so that one of
-its configuration macros, @code{ALWAYS_FLUSH}, was defined.
-
-This was done as a result of a belief that many programs expected
-output to be flushed to the operating system (under UNIX, via
-the @code{fflush()} library call) with the result that errors,
-such as disk full, would be immediately flagged via the
-relevant @code{ERR=} and @code{IOSTAT=} mechanism.
-
-Because of the adverse effects this approach had on the performance
-of many programs, @command{g77} no longer configures @code{libf2c}
-(now named @code{libg2c} in its @command{g77} incarnation)
-to always flush output.
-
-If your program depends on this behavior, either insert the
-appropriate @samp{CALL FLUSH} statements, or modify the sources
-to the @code{libg2c}, rebuild and reinstall @command{g77}, and
-relink your programs with the modified library.
-
-(Ideally, @code{libg2c} would offer the choice at run-time, so
-that a compile-time option to @command{g77} or @command{f2c} could
-result in generating the appropriate calls to flushing or
-non-flushing library routines.)
-
-Some Fortran programs require output
-(writes) to be flushed to the operating system (under UNIX,
-via the @code{fflush()} library call) so that errors,
-such as disk full, are immediately flagged via the relevant
-@code{ERR=} and @code{IOSTAT=} mechanism, instead of such
-errors being flagged later as subsequent writes occur, forcing
-the previously written data to disk, or when the file is
-closed.
-
-Essentially, the difference can be viewed as synchronous error
-reporting (immediate flagging of errors during writes) versus
-asynchronous, or, more precisely, buffered error reporting
-(detection of errors might be delayed).
-
-@code{libg2c} supports flagging write errors immediately when
-it is built with the @code{ALWAYS_FLUSH} macro defined.
-This results in a @code{libg2c} that runs slower, sometimes
-quite a bit slower, under certain circumstances---for example,
-accessing files via the networked file system NFS---but the
-effect can be more reliable, robust file I/O.
-
-If you know that Fortran programs requiring this level of precision
-of error reporting are to be compiled using the
-version of @command{g77} you are building, you might wish to
-modify the @command{g77} source tree so that the version of
-@code{libg2c} is built with the @code{ALWAYS_FLUSH} macro
-defined, enabling this behavior.
-
-To do this, find this line in @file{@value{path-libf2c}/f2c.h} in
-your @command{g77} source tree:
-
-@example
-/* #define ALWAYS_FLUSH */
-@end example
-
-Remove the leading @samp{/*@w{ }},
-so the line begins with @samp{#define},
-and the trailing @samp{@w{ }*/}.
-
-Then build or rebuild @command{g77} as appropriate.
-
-@node Large File Unit Numbers
-@subsection Large File Unit Numbers
-@cindex MXUNIT
-@cindex unit numbers
-@cindex maximum unit number
-@cindex illegal unit number
-@cindex increasing maximum unit number
-
-If your program crashes at run time with a message including
-the text @samp{illegal unit number}, that probably is
-a message from the run-time library, @code{libg2c}.
-
-The message means that your program has attempted to use a
-file unit number that is out of the range accepted by
-@code{libg2c}.
-Normally, this range is 0 through 99, and the high end
-of the range is controlled by a @code{libg2c} source-file
-macro named @code{MXUNIT}.
-
-If you can easily change your program to use unit numbers
-in the range 0 through 99, you should do so.
-
-As distributed, whether as part of @command{f2c} or @command{g77},
-@code{libf2c} accepts file unit numbers only in the range
-0 through 99.
-For example, a statement such as @samp{WRITE (UNIT=100)} causes
-a run-time crash in @code{libf2c}, because the unit number,
-100, is out of range.
-
-If you know that Fortran programs at your installation require
-the use of unit numbers higher than 99, you can change the
-value of the @code{MXUNIT} macro, which represents the maximum unit
-number, to an appropriately higher value.
-
-To do this, edit the file @file{@value{path-libf2c}/libI77/fio.h} in your
-@command{g77} source tree, changing the following line:
-
-@example
-#define MXUNIT 100
-@end example
-
-Change the line so that the value of @code{MXUNIT} is defined to be
-at least one @emph{greater} than the maximum unit number used by
-the Fortran programs on your system.
-
-(For example, a program that does @samp{WRITE (UNIT=255)} would require
-@code{MXUNIT} set to at least 256 to avoid crashing.)
-
-Then build or rebuild @command{g77} as appropriate.
-
-@emph{Note:} Changing this macro has @emph{no} effect on other limits
-your system might place on the number of files open at the same time.
-That is, the macro might allow a program to do @samp{WRITE (UNIT=100)},
-but the library and operating system underlying @code{libf2c} might
-disallow it if many other files have already been opened (via @code{OPEN} or
-implicitly via @code{READ}, @code{WRITE}, and so on).
-Information on how to increase these other limits should be found
-in your system's documentation.
-
-@node Floating-point precision
-@subsection Floating-point precision
-
-@cindex IEEE 754 conformance
-@cindex conformance, IEEE 754
-@cindex floating-point, precision
-@cindex ix86 floating-point
-@cindex x86 floating-point
-If your program depends on exact IEEE 754 floating-point handling it may
-help on some systems---specifically x86 or m68k hardware---to use
-the @option{-ffloat-store} option or to reset the precision flag on the
-floating-point unit.
-@xref{Optimize Options}.
-
-However, it might be better simply to put the FPU into double precision
-mode and not take the performance hit of @option{-ffloat-store}.  On x86
-and m68k GNU systems you can do this with a technique similar to that
-for turning on floating-point exceptions
-(@pxref{Floating-point Exception Handling}).
-The control word could be set to double precision by some code like this
-one:
-@smallexample
-#include <fpu_control.h>
-@{
-  fpu_control_t cw = (_FPU_DEFAULT & ~_FPU_EXTENDED) | _FPU_DOUBLE;
-  _FPU_SETCW(cw);
-@}
-@end smallexample
-(It is not clear whether this has any effect on the operation of the GNU
-maths library, but we have no evidence of it causing trouble.)
-
-Some targets (such as the Alpha) may need special options for full IEEE
-conformance.
-@xref{Submodel Options,,Hardware Models and Configurations,gcc,Using
-the GNU Compiler Collection (GCC)}.
-
-@node Inconsistent Calling Sequences
-@subsection Inconsistent Calling Sequences
-
-@pindex ftnchek
-@cindex floating-point, errors
-@cindex ix86 FPU stack
-@cindex x86 FPU stack
-Code containing inconsistent calling sequences in the same file is
-normally rejected---see @ref{GLOBALS}.
-(Use, say, @command{ftnchek} to ensure
-consistency across source files.
-@xref{f2c Skeletons and Prototypes,,
-Generating Skeletons and Prototypes with @command{f2c}}.)
-
-Mysterious errors, which may appear to be code generation problems, can
-appear specifically on the x86 architecture with some such
-inconsistencies.  On x86 hardware, floating-point return values of
-functions are placed on the floating-point unit's register stack, not
-the normal stack.  Thus calling a @code{REAL} or @code{DOUBLE PRECISION}
-@code{FUNCTION} as some other sort of procedure, or vice versa,
-scrambles the floating-point stack.  This may break unrelated code
-executed later.  Similarly if, say, external C routines are written
-incorrectly.
-
-@node Overly Convenient Options
-@section Overly Convenient Command-line Options
-@cindex overly convenient options
-@cindex options, overly convenient
-
-These options should be used only as a quick-and-dirty way to determine
-how well your program will run under different compilation models
-without having to change the source.
-Some are more problematic
-than others, depending on how portable and maintainable you want the
-program to be (and, of course, whether you are allowed to change it
-at all is crucial).
-
-You should not continue to use these command-line options to compile
-a given program, but rather should make changes to the source code:
-
-@table @code
-@cindex -finit-local-zero option
-@cindex options, -finit-local-zero
-@item -finit-local-zero
-(This option specifies that any uninitialized local variables
-and arrays have default initialization to binary zeros.)
-
-Many other compilers do this automatically, which means lots of
-Fortran code developed with those compilers depends on it.
-
-It is safer (and probably
-would produce a faster program) to find the variables and arrays that
-need such initialization and provide it explicitly via @code{DATA}, so that
-@option{-finit-local-zero} is not needed.
-
-Consider using @option{-Wuninitialized} (which requires @option{-O}) to
-find likely candidates, but
-do not specify @option{-finit-local-zero} or @option{-fno-automatic},
-or this technique won't work.
-
-@cindex -fno-automatic option
-@cindex options, -fno-automatic
-@item -fno-automatic
-(This option specifies that all local variables and arrays
-are to be treated as if they were named in @code{SAVE} statements.)
-
-Many other compilers do this automatically, which means lots of
-Fortran code developed with those compilers depends on it.
-
-The effect of this is that all non-automatic variables and arrays
-are made static, that is, not placed on the stack or in heap storage.
-This might cause a buggy program to appear to work better.
-If so, rather than relying on this command-line option (and hoping all
-compilers provide the equivalent one), add @code{SAVE}
-statements to some or all program unit sources, as appropriate.
-Consider using @option{-Wuninitialized} (which requires @option{-O})
-to find likely candidates, but
-do not specify @option{-finit-local-zero} or @option{-fno-automatic},
-or this technique won't work.
-
-The default is @option{-fautomatic}, which tells @command{g77} to try
-and put variables and arrays on the stack (or in fast registers)
-where possible and reasonable.
-This tends to make programs faster.
-
-@cindex automatic arrays
-@cindex arrays, automatic
-@emph{Note:} Automatic variables and arrays are not affected
-by this option.
-These are variables and arrays that are @emph{necessarily} automatic,
-either due to explicit statements, or due to the way they are
-declared.
-Examples include local variables and arrays not given the
-@code{SAVE} attribute in procedures declared @code{RECURSIVE},
-and local arrays declared with non-constant bounds (automatic
-arrays).
-Currently, @command{g77} supports only automatic arrays, not
-@code{RECURSIVE} procedures or other means of explicitly
-specifying that variables or arrays are automatic.
-
-@cindex -f@var{group}-intrinsics-hide option
-@cindex options, -f@var{group}-intrinsics-hide
-@item -f@var{group}-intrinsics-hide
-Change the source code to use @code{EXTERNAL} for any external procedure
-that might be the name of an intrinsic.
-It is easy to find these using @option{-f@var{group}-intrinsics-disable}.
-@end table
-
-@node Faster Programs
-@section Faster Programs
-@cindex speed, of programs
-@cindex programs, speeding up
-
-Aside from the usual @command{gcc} options, such as @option{-O},
-@option{-ffast-math}, and so on, consider trying some of the
-following approaches to speed up your program (once you get
-it working).
-
-@menu
-* Aligned Data::
-* Prefer Automatic Uninitialized Variables::
-* Avoid f2c Compatibility::
-* Use Submodel Options::
-@end menu
-
-@node Aligned Data
-@subsection Aligned Data
-@cindex alignment
-@cindex data, aligned
-@cindex stack, aligned
-@cindex aligned data
-@cindex aligned stack
-@cindex Pentium optimizations
-@cindex optimization, for Pentium
-
-On some systems, such as those with Pentium Pro CPUs, programs
-that make heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION})
-might run much slower
-than possible due to the compiler not aligning these 64-bit
-values to 64-bit boundaries in memory.
-(The effect also is present, though
-to a lesser extent, on the 586 (Pentium) architecture.)
-
-The Intel x86 architecture generally ensures that these programs will
-work on all its implementations,
-but particular implementations (such as Pentium Pro)
-perform better with more strict alignment.
-(Such behavior isn't unique to the Intel x86 architecture.)
-Other architectures might @emph{demand} 64-bit alignment
-of 64-bit data.
-
-There are a variety of approaches to use to address this problem:
-
-@itemize @bullet
-@item
-@cindex @code{COMMON} layout
-@cindex layout of @code{COMMON} blocks
-Order your @code{COMMON} and @code{EQUIVALENCE} areas such
-that the variables and arrays with the widest alignment
-guidelines come first.
-
-For example, on most systems, this would mean placing
-@code{COMPLEX(KIND=2)}, @code{REAL(KIND=2)}, and
-@code{INTEGER(KIND=2)} entities first, followed by @code{REAL(KIND=1)},
-@code{INTEGER(KIND=1)}, and @code{LOGICAL(KIND=1)} entities, then
-@code{INTEGER(KIND=6)} entities, and finally @code{CHARACTER}
-and @code{INTEGER(KIND=3)} entities.
-
-The reason to use such placement is it makes it more likely
-that your data will be aligned properly, without requiring
-you to do detailed analysis of each aggregate (@code{COMMON}
-and @code{EQUIVALENCE}) area.
-
-Specifically, on systems where the above guidelines are
-appropriate, placing @code{CHARACTER} entities before
-@code{REAL(KIND=2)} entities can work just as well,
-but only if the number of bytes occupied by the @code{CHARACTER}
-entities is divisible by the recommended alignment for
-@code{REAL(KIND=2)}.
-
-By ordering the placement of entities in aggregate
-areas according to the simple guidelines above, you
-avoid having to carefully count the number of bytes
-occupied by each entity to determine whether the
-actual alignment of each subsequent entity meets the
-alignment guidelines for the type of that entity.
-
-If you don't ensure correct alignment of @code{COMMON} elements, the
-compiler may be forced by some systems to violate the Fortran semantics by
-adding padding to get @code{DOUBLE PRECISION} data properly aligned.
-If the unfortunate practice is employed of overlaying different types of
-data in the @code{COMMON} block, the different variants
-of this block may become misaligned with respect to each other.
-Even if your platform doesn't require strict alignment,
-@code{COMMON} should be laid out as above for portability.
-(Unfortunately the FORTRAN 77 standard didn't anticipate this
-possible requirement, which is compiler-independent on a given platform.)
-
-@item
-@cindex -malign-double option
-@cindex options, -malign-double
-Use the (x86-specific) @option{-malign-double} option when compiling
-programs for the Pentium and Pentium Pro architectures (called 586
-and 686 in the @command{gcc} configuration subsystem).
-The warning about this in the @command{gcc} manual isn't
-generally relevant to Fortran,
-but using it will force @code{COMMON} to be padded if necessary to align
-@code{DOUBLE PRECISION} data.
-
-When @code{DOUBLE PRECISION} data is forcibly aligned
-in @code{COMMON} by @command{g77} due to specifying @option{-malign-double},
-@command{g77} issues a warning about the need to
-insert padding.
-
-In this case, each and every program unit that uses
-the same @code{COMMON} area
-must specify the same layout of variables and their types
-for that area
-and be compiled with @option{-malign-double} as well.
-@command{g77} will issue warnings in each case,
-but as long as every program unit using that area
-is compiled with the same warnings,
-the resulting object files should work when linked together
-unless the program makes additional assumptions about
-@code{COMMON} area layouts that are outside the scope
-of the FORTRAN 77 standard,
-or uses @code{EQUIVALENCE} or different layouts
-in ways that assume no padding is ever inserted by the compiler.
-
-@item
-Ensure that @file{crt0.o} or @file{crt1.o}
-on your system guarantees a 64-bit
-aligned stack for @code{main()}.
-The recent one from GNU (@code{glibc2}) will do this on x86 systems,
-but we don't know of any other x86 setups where it will be right.
-Read your system's documentation to determine if
-it is appropriate to upgrade to a more recent version
-to obtain the optimal alignment.
-@end itemize
-
-Progress is being made on making this work
-``out of the box'' on future versions of @command{g77},
-@command{gcc}, and some of the relevant operating systems
-(such as GNU/Linux).
-
-@node Prefer Automatic Uninitialized Variables
-@subsection Prefer Automatic Uninitialized Variables
-
-If you're using @option{-fno-automatic} already, you probably
-should change your code to allow compilation with @option{-fautomatic}
-(the default), to allow the program to run faster.
-
-Similarly, you should be able to use @option{-fno-init-local-zero}
-(the default) instead of @option{-finit-local-zero}.
-This is because it is rare that every variable affected by these
-options in a given program actually needs to
-be so affected.
-
-For example, @option{-fno-automatic}, which effectively @code{SAVE}s
-every local non-automatic variable and array, affects even things like
-@code{DO} iteration
-variables, which rarely need to be @code{SAVE}d, and this often reduces
-run-time performances.
-Similarly, @option{-fno-init-local-zero} forces such
-variables to be initialized to zero---when @code{SAVE}d (such as when
-@option{-fno-automatic}), this by itself generally affects only
-startup time for a program, but when not @code{SAVE}d,
-it can slow down the procedure every time it is called.
-
-@xref{Overly Convenient Options,,Overly Convenient Command-Line Options},
-for information on the @option{-fno-automatic} and
-@option{-finit-local-zero} options and how to convert
-their use into selective changes in your own code.
-
-@node Avoid f2c Compatibility
-@subsection Avoid f2c Compatibility
-@cindex -fno-f2c option
-@cindex options, -fno-f2c
-@cindex @command{f2c} compatibility
-@cindex compatibility, @command{f2c}
-
-If you aren't linking with any code compiled using
-@command{f2c}, try using the @option{-fno-f2c} option when
-compiling @emph{all} the code in your program.
-(Note that @code{libf2c} is @emph{not} an example of code
-that is compiled using @command{f2c}---it is compiled by a C
-compiler, typically @command{gcc}.)
-
-@node Use Submodel Options
-@subsection Use Submodel Options
-@cindex submodels
-
-Using an appropriate @option{-m} option to generate specific code for your
-CPU may be worthwhile, though it may mean the executable won't run on
-other versions of the CPU that don't support the same instruction set.
-@xref{Submodel Options,,Hardware Models and Configurations,gcc,Using the
-GNU Compiler Collection (GCC)}.  For instance on an x86 system the
-compiler might have
-been built---as shown by @samp{g77 -v}---for the target
-@samp{i386-pc-linux-gnu}, i.e.@: an @samp{i386} CPU@.  In that case to
-generate code best optimized for a Pentium you could use the option
-@option{-march=pentium}.
-
-For recent CPUs that don't have explicit support in the released version
-of @command{gcc}, it @emph{might} still be possible to get improvements
-with certain @option{-m} options.
-
-@option{-fomit-frame-pointer} can help performance on x86 systems and
-others.  It will, however, inhibit debugging on the systems on which it
-is not turned on anyway by @option{-O}.
-
-@node Trouble
-@chapter Known Causes of Trouble with GNU Fortran
-@cindex bugs, known
-@cindex installation trouble
-@cindex known causes of trouble
-
-This section describes known problems that affect users of GNU Fortran.
-Most of these are not GNU Fortran bugs per se---if they were, we would
-fix them.
-But the result for a user might be like the result of a bug.
-
-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.
-
-(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}.
-Anytime a bug seems to have more to do with the @command{gcc}
-portion of @command{g77}, see
-@ref{Trouble,,Known Causes of Trouble with GCC,
-gcc,Using the GNU Compiler Collection (GCC)}.)
-
-@menu
-* But-bugs::         Bugs really in other programs or elsewhere.
-* Known Bugs::       Bugs known to be in this version of @command{g77}.
-* Missing Features:: Features we already know we want to add later.
-* Disappointments::  Regrettable things we can't change.
-* Non-bugs::         Things we think are right, but some others disagree.
-* Warnings and Errors::  Which problems in your code get warnings,
-                        and which get errors.
-@end menu
-
-@node But-bugs
-@section Bugs Not In GNU Fortran
-@cindex but-bugs
-
-These are bugs to which the maintainers often have to reply,
-``but that isn't a bug in @command{g77}@dots{}''.
-Some of these already are fixed in new versions of other
-software; some still need to be fixed; some are problems
-with how @command{g77} is installed or is being used;
-some are the result of bad hardware that causes software
-to misbehave in sometimes bizarre ways;
-some just cannot be addressed at this time until more
-is known about the problem.
-
-Please don't re-report these bugs to the @command{g77} maintainers---if
-you must remind someone how important it is to you that the problem
-be fixed, talk to the people responsible for the other products
-identified below, but preferably only after you've tried the
-latest versions of those products.
-The @command{g77} maintainers have their hands full working on
-just fixing and improving @command{g77}, without serving as a
-clearinghouse for all bugs that happen to affect @command{g77}
-users.
-
-@xref{Collected Fortran Wisdom}, for information on behavior
-of Fortran programs, and the programs that compile them, that
-might be @emph{thought} to indicate bugs.
-
-@menu
-* Signal 11 and Friends::  Strange behavior by any software.
-* Cannot Link Fortran Programs::  Unresolved references.
-* Large Common Blocks::    Problems on older GNU/Linux systems.
-* Debugger Problems::      When the debugger crashes.
-* NeXTStep Problems::      Misbehaving executables.
-* Stack Overflow::         More misbehaving executables.
-* Nothing Happens::        Less behaving executables.
-* Strange Behavior at Run Time::  Executables misbehaving due to
-                            bugs in your program.
-* Floating-point Errors::  The results look wrong, but@dots{}.
-@end menu
-
-@node Signal 11 and Friends
-@subsection Signal 11 and Friends
-@cindex signal 11
-@cindex hardware errors
-
-A whole variety of strange behaviors can occur when the
-software, or the way you are using the software,
-stresses the hardware in a way that triggers hardware bugs.
-This might seem hard to believe, but it happens frequently
-enough that there exist documents explaining in detail
-what the various causes of the problems are, what
-typical symptoms look like, and so on.
-
-Generally these problems are referred to in this document
-as ``signal 11'' crashes, because the Linux kernel, running
-on the most popular hardware (the Intel x86 line), often
-stresses the hardware more than other popular operating
-systems.
-When hardware problems do occur under GNU/Linux on x86
-systems, these often manifest themselves as ``signal 11''
-problems, as illustrated by the following diagnostic:
-
-@smallexample
-sh# @kbd{g77 myprog.f}
-gcc: Internal compiler error: program f771 got fatal signal 11
-sh#
-@end smallexample
-
-It is @emph{very} important to remember that the above
-message is @emph{not} the only one that indicates a
-hardware problem, nor does it always indicate a hardware
-problem.
-
-In particular, on systems other than those running the Linux
-kernel, the message might appear somewhat or very different,
-as it will if the error manifests itself while running a
-program other than the @command{g77} compiler.
-For example,
-it will appear somewhat different when running your program,
-when running Emacs, and so on.
-
-How to cope with such problems is well beyond the scope
-of this manual.
-
-However, users of Linux-based systems (such as GNU/Linux)
-should review @uref{http://www.bitwizard.nl/sig11/}, a source
-of detailed information on diagnosing hardware problems,
-by recognizing their common symptoms.
-
-Users of other operating systems and hardware might
-find this reference useful as well.
-If you know of similar material for another hardware/software
-combination, please let us know so we can consider including
-a reference to it in future versions of this manual.
-
-@node Cannot Link Fortran Programs
-@subsection Cannot Link Fortran Programs
-@cindex unresolved reference (various)
-@cindex linking error for user code
-@cindex code, user
-@cindex @command{ld}, error linking user code
-@cindex @command{ld}, can't find strange names
-On some systems, perhaps just those with out-of-date (shared?)
-libraries, unresolved-reference errors happen when linking @command{g77}-compiled
-programs (which should be done using @command{g77}).
-
-If this happens to you, try appending @option{-lc} to the command you
-use to link the program, e.g. @samp{g77 foo.f -lc}.
-@command{g77} already specifies @samp{-lg2c -lm} when it calls the linker,
-but it cannot also specify @option{-lc} because not all systems have a
-file named @file{libc.a}.
-
-It is unclear at this point whether there are legitimately installed
-systems where @samp{-lg2c -lm} is insufficient to resolve code produced
-by @command{g77}.
-
-@cindex undefined reference (_main)
-@cindex linking error, user code
-@cindex @command{ld}, error linking user code
-@cindex code, user
-@cindex @command{ld}, can't find @samp{_main}
-If your program doesn't link due to unresolved references to names
-like @samp{_main}, make sure you're using the @command{g77} command to do the
-link, since this command ensures that the necessary libraries are
-loaded by specifying @samp{-lg2c -lm} when it invokes the @command{gcc}
-command to do the actual link.
-(Use the @option{-v} option to discover
-more about what actually happens when you use the @command{g77} and @command{gcc}
-commands.)
-
-Also, try specifying @option{-lc} as the last item on the @command{g77}
-command line, in case that helps.
-
-@node Large Common Blocks
-@subsection Large Common Blocks
-@cindex common blocks, large
-@cindex large common blocks
-@cindex linking, errors
-@cindex @command{ld}, errors
-@cindex errors, linker
-On some older GNU/Linux systems, programs with common blocks larger
-than 16MB cannot be linked without some kind of error
-message being produced.
-
-This is a bug in older versions of @command{ld}, fixed in
-more recent versions of @code{binutils}, such as version 2.6.
-
-@node Debugger Problems
-@subsection Debugger Problems
-@cindex @command{gdb}, support
-@cindex support, @command{gdb}
-There are some known problems when using @command{gdb} on code
-compiled by @command{g77}.
-Inadequate investigation as of the release of 0.5.16 results in not
-knowing which products are the culprit, but @file{gdb-4.14} definitely
-crashes when, for example, an attempt is made to print the contents
-of a @code{COMPLEX(KIND=2)} dummy array, on at least some GNU/Linux
-machines, plus some others.
-Attempts to access assumed-size arrays are
-also known to crash recent versions of @command{gdb}.
-(@command{gdb}'s Fortran support was done for a different compiler
-and isn't properly compatible with @command{g77}.)
-
-@node NeXTStep Problems
-@subsection NeXTStep Problems
-@cindex NeXTStep problems
-@cindex bus error
-@cindex segmentation violation
-Developers of Fortran code on NeXTStep (all architectures) have to
-watch out for the following problem when writing programs with
-large, statically allocated (i.e. non-stack based) data structures
-(common blocks, saved arrays).
-
-Due to the way the native loader (@file{/bin/ld}) lays out
-data structures in virtual memory, it is very easy to create an
-executable wherein the @samp{__DATA} segment overlaps (has addresses in
-common) with the @samp{UNIX STACK} segment.
-
-This leads to all sorts of trouble, from the executable simply not
-executing, to bus errors.
-The NeXTStep command line tool @command{ebadexec} points to
-the problem as follows:
-
-@smallexample
-% @kbd{/bin/ebadexec a.out}
-/bin/ebadexec: __LINKEDIT segment (truncated address = 0x3de000
-rounded size = 0x2a000) of executable file: a.out overlaps with UNIX
-STACK segment (truncated address = 0x400000 rounded size =
-0x3c00000) of executable file: a.out
-@end smallexample
-
-(In the above case, it is the @samp{__LINKEDIT} segment that overlaps the
-stack segment.)
-
-This can be cured by assigning the @samp{__DATA} segment
-(virtual) addresses beyond the stack segment.
-A conservative
-estimate for this is from address 6000000 (hexadecimal) onwards---this
-has always worked for me [Toon Moene]:
-
-@smallexample
-% @kbd{g77 -segaddr __DATA 6000000 test.f}
-% @kbd{ebadexec a.out}
-ebadexec: file: a.out appears to be executable
-%
-@end smallexample
-
-Browsing through @file{@value{path-g77}/Makefile.in},
-you will find that the @code{f771} program itself also has to be
-linked with these flags---it has large statically allocated
-data structures.
-(Version 0.5.18 reduces this somewhat, but probably
-not enough.)
-
-(The above item was contributed by Toon Moene
-(@email{toon@@moene.indiv.nluug.nl}).)
-
-@node Stack Overflow
-@subsection Stack Overflow
-@cindex stack, overflow
-@cindex segmentation violation
-@command{g77} code might fail at runtime (probably with a ``segmentation
-violation'') due to overflowing the stack.
-This happens most often on systems with an environment
-that provides substantially more heap space (for use
-when arbitrarily allocating and freeing memory) than stack
-space.
-
-Often this can be cured by
-increasing or removing your shell's limit on stack usage, typically
-using @kbd{limit stacksize} (in @command{csh} and derivatives) or
-@kbd{ulimit -s} (in @command{sh} and derivatives).
-
-Increasing the allowed stack size might, however, require
-changing some operating system or system configuration parameters.
-
-You might be able to work around the problem by compiling with the
-@option{-fno-automatic} option to reduce stack usage, probably at the
-expense of speed.
-
-@command{g77}, on most machines, puts many variables and arrays on the stack
-where possible, and can be configured (by changing
-@code{FFECOM_sizeMAXSTACKITEM} in @file{@value{path-g77}/com.c}) to force
-smaller-sized entities into static storage (saving
-on stack space) or permit larger-sized entities to be put on the
-stack (which can improve run-time performance, as it presents
-more opportunities for the GBE to optimize the generated code).
-
-@emph{Note:} Putting more variables and arrays on the stack
-might cause problems due to system-dependent limits on stack size.
-Also, the value of @code{FFECOM_sizeMAXSTACKITEM} has no
-effect on automatic variables and arrays.
-@xref{But-bugs}, for more information.
-@emph{Note:} While @code{libg2c} places a limit on the range
-of Fortran file-unit numbers, the underlying library and operating
-system might impose different kinds of limits.
-For example, some systems limit the number of files simultaneously
-open by a running program.
-Information on how to increase these limits should be found
-in your system's documentation.
-
-@cindex automatic arrays
-@cindex arrays, automatic
-However, if your program uses large automatic arrays
-(for example, has declarations like @samp{REAL A(N)} where
-@samp{A} is a local array and @samp{N} is a dummy or
-@code{COMMON} variable that can have a large value),
-neither use of @option{-fno-automatic},
-nor changing the cut-off point for @command{g77} for using the stack,
-will solve the problem by changing the placement of these
-large arrays, as they are @emph{necessarily} automatic.
-
-@command{g77} currently provides no means to specify that
-automatic arrays are to be allocated on the heap instead
-of the stack.
-So, other than increasing the stack size, your best bet is to
-change your source code to avoid large automatic arrays.
-Methods for doing this currently are outside the scope of
-this document.
-
-(@emph{Note:} If your system puts stack and heap space in the
-same memory area, such that they are effectively combined, then
-a stack overflow probably indicates a program that is either
-simply too large for the system, or buggy.)
-
-@node Nothing Happens
-@subsection Nothing Happens
-@cindex nothing happens
-@cindex naming programs
-@cindex @command{test} programs
-@cindex programs, @command{test}
-It is occasionally reported that a ``simple'' program,
-such as a ``Hello, World!'' program, does nothing when
-it is run, even though the compiler reported no errors,
-despite the program containing nothing other than a
-simple @code{PRINT} statement.
-
-This most often happens because the program has been
-compiled and linked on a UNIX system and named @command{test},
-though other names can lead to similarly unexpected
-run-time behavior on various systems.
-
-Essentially this problem boils down to giving
-your program a name that is already known to
-the shell you are using to identify some other program,
-which the shell continues to execute instead of your
-program when you invoke it via, for example:
-
-@smallexample
-sh# @kbd{test}
-sh#
-@end smallexample
-
-Under UNIX and many other system, a simple command name
-invokes a searching mechanism that might well not choose
-the program located in the current working directory if
-there is another alternative (such as the @command{test}
-command commonly installed on UNIX systems).
-
-The reliable way to invoke a program you just linked in
-the current directory under UNIX is to specify it using
-an explicit pathname, as in:
-
-@smallexample
-sh# @kbd{./test}
- Hello, World!
-sh#
-@end smallexample
-
-Users who encounter this problem should take the time to
-read up on how their shell searches for commands, how to
-set their search path, and so on.
-The relevant UNIX commands to learn about include
-@command{man}, @command{info} (on GNU systems), @command{setenv} (or
-@command{set} and @command{env}), @command{which}, and @command{find}.
-
-@node Strange Behavior at Run Time
-@subsection Strange Behavior at Run Time
-@cindex segmentation violation
-@cindex bus error
-@cindex overwritten data
-@cindex data, overwritten
-@command{g77} code might fail at runtime with ``segmentation violation'',
-``bus error'', or even something as subtle as a procedure call
-overwriting a variable or array element that it is not supposed
-to touch.
-
-These can be symptoms of a wide variety of actual bugs that
-occurred earlier during the program's run, but manifested
-themselves as @emph{visible} problems some time later.
-
-Overflowing the bounds of an array---usually by writing beyond
-the end of it---is one of two kinds of bug that often occurs
-in Fortran code.
-(Compile your code with the @option{-fbounds-check} option
-to catch many of these kinds of errors at program run time.)
-
-The other kind of bug is a mismatch between the actual arguments
-passed to a procedure and the dummy arguments as declared by that
-procedure.
-
-Both of these kinds of bugs, and some others as well, can be
-difficult to track down, because the bug can change its behavior,
-or even appear to not occur, when using a debugger.
-
-That is, these bugs can be quite sensitive to data, including
-data representing the placement of other data in memory (that is,
-pointers, such as the placement of stack frames in memory).
-
-@command{g77} now offers the
-ability to catch and report some of these problems at compile, link, or
-run time, such as by generating code to detect references to
-beyond the bounds of most arrays (except assumed-size arrays),
-and checking for agreement between calling and called procedures.
-Future improvements are likely to be made in the procedure-mismatch area,
-at least.
-
-In the meantime, finding and fixing the programming
-bugs that lead to these behaviors is, ultimately, the user's
-responsibility, as difficult as that task can sometimes be.
-
-@cindex infinite spaces printed
-@cindex space, endless printing of
-@cindex libc, non-ANSI or non-default
-@cindex C library
-@cindex linking against non-standard library
-@cindex Solaris
-One runtime problem that has been observed might have a simple solution.
-If a formatted @code{WRITE} produces an endless stream of spaces, check
-that your program is linked against the correct version of the C library.
-The configuration process takes care to account for your
-system's normal @file{libc} not being ANSI-standard, which will
-otherwise cause this behavior.
-If your system's default library is
-ANSI-standard and you subsequently link against a non-ANSI one, there
-might be problems such as this one.
-
-Specifically, on Solaris2 systems,
-avoid picking up the @code{BSD} library from @file{/usr/ucblib}.
-
-@node Floating-point Errors
-@subsection Floating-point Errors
-@cindex floating-point errors
-@cindex rounding errors
-@cindex inconsistent floating-point results
-@cindex results, inconsistent
-Some programs appear to produce inconsistent floating-point
-results compiled by @command{g77} versus by other compilers.
-
-Often the reason for this behavior is the fact that floating-point
-values are represented on almost all Fortran systems by
-@emph{approximations}, and these approximations are inexact
-even for apparently simple values like 0.1, 0.2, 0.3, 0.4, 0.6,
-0.7, 0.8, 0.9, 1.1, and so on.
-Most Fortran systems, including all current ports of @command{g77},
-use binary arithmetic to represent these approximations.
-
-Therefore, the exact value of any floating-point approximation
-as manipulated by @command{g77}-compiled code is representable by
-adding some combination of the values 1.0, 0.5, 0.25, 0.125, and
-so on (just keep dividing by two) through the precision of the
-fraction (typically around 23 bits for @code{REAL(KIND=1)}, 52 for
-@code{REAL(KIND=2)}), then multiplying the sum by a integral
-power of two (in Fortran, by @samp{2**N}) that typically is between
--127 and +128 for @code{REAL(KIND=1)} and -1023 and +1024 for
-@code{REAL(KIND=2)}, then multiplying by -1 if the number
-is negative.
-
-So, a value like 0.2 is exactly represented in decimal---since
-it is a fraction, @samp{2/10}, with a denominator that is compatible
-with the base of the number system (base 10).
-However, @samp{2/10} cannot be represented by any finite number
-of sums of any of 1.0, 0.5, 0.25, and so on, so 0.2 cannot
-be exactly represented in binary notation.
-
-(On the other hand, decimal notation can represent any binary
-number in a finite number of digits.
-Decimal notation cannot do so with ternary, or base-3,
-notation, which would represent floating-point numbers as
-sums of any of @samp{1/1}, @samp{1/3}, @samp{1/9}, and so on.
-After all, no finite number of decimal digits can exactly
-represent @samp{1/3}.
-Fortunately, few systems use ternary notation.)
-
-Moreover, differences in the way run-time I/O libraries convert
-between these approximations and the decimal representation often
-used by programmers and the programs they write can result in
-apparent differences between results that do not actually exist,
-or exist to such a small degree that they usually are not worth
-worrying about.
-
-For example, consider the following program:
-
-@smallexample
-PRINT *, 0.2
-END
-@end smallexample
-
-When compiled by @command{g77}, the above program might output
-@samp{0.20000003}, while another compiler might produce a
-executable that outputs @samp{0.2}.
-
-This particular difference is due to the fact that, currently,
-conversion of floating-point values by the @code{libg2c} library,
-used by @command{g77}, handles only double-precision values.
-
-Since @samp{0.2} in the program is a single-precision value, it
-is converted to double precision (still in binary notation)
-before being converted back to decimal.
-The conversion to binary appends @emph{binary} zero digits to the
-original value---which, again, is an inexact approximation of
-0.2---resulting in an approximation that is much less exact
-than is connoted by the use of double precision.
-
-(The appending of binary zero digits has essentially the same
-effect as taking a particular decimal approximation of
-@samp{1/3}, such as @samp{0.3333333}, and appending decimal
-zeros to it, producing @samp{0.33333330000000000}.
-Treating the resulting decimal approximation as if it really
-had 18 or so digits of valid precision would make it seem
-a very poor approximation of @samp{1/3}.)
-
-As a result of converting the single-precision approximation
-to double precision by appending binary zeros, the conversion
-of the resulting double-precision
-value to decimal produces what looks like an incorrect
-result, when in fact the result is @emph{inexact}, and
-is probably no less inaccurate or imprecise an approximation
-of 0.2 than is produced by other compilers that happen to output
-the converted value as ``exactly'' @samp{0.2}.
-(Some compilers behave in a way that can make them appear
-to retain more accuracy across a conversion of a single-precision
-constant to double precision.
-@xref{Context-Sensitive Constants}, to see why
-this practice is illusory and even dangerous.)
-
-Note that a more exact approximation of the constant is
-computed when the program is changed to specify a
-double-precision constant:
-
-@smallexample
-PRINT *, 0.2D0
-END
-@end smallexample
-
-Future versions of @command{g77} and/or @code{libg2c} might convert
-single-precision values directly to decimal,
-instead of converting them to double precision first.
-This would tend to result in output that is more consistent
-with that produced by some other Fortran implementations.
-
-A useful source of information on floating-point computation is David
-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/}.
-
-Information related to the IEEE 754
-floating-point standard by a leading light can be found at
-@uref{http://http.cs.berkeley.edu/%7Ewkahan/ieee754status/};
-see also slides from the short course referenced from
-@uref{http://http.cs.berkeley.edu/%7Efateman/}.
-
-The supplement to the PostScript-formatted Goldberg document,
-referenced above, is available in HTML format.
-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
-to 32-bit or 64-bit values by the compiler
-as ``spills''.
-
-@cindex spills of floating-point results
-@cindex 80-bit spills
-@cindex truncation, of floating-point values
-(@emph{Note:} @command{g77} specifically, and @command{gcc} generally,
-does arbitrarily truncate 80-bit results during spills
-as of this writing.
-It is not yet clear whether a future version of
-the GNU compiler suite will offer 80-bit spills
-as an option, or perhaps even as the default behavior.)
-
-@c xref would be different between editions:
-The GNU C library provides routines for controlling the FPU, and other
-documentation about this.
-
-@xref{Floating-point precision}, regarding IEEE 754 conformance.
-
-@include bugs.texi
-
-@node Missing Features
-@section Missing Features
-
-This section lists features we know are missing from @command{g77},
-and which we want to add someday.
-(There is no priority implied in the ordering below.)
-
-@menu
-GNU Fortran language:
-* Better Source Model::
-* Fortran 90 Support::
-* Intrinsics in PARAMETER Statements::
-* Arbitrary Concatenation::
-* SELECT CASE on CHARACTER Type::
-* RECURSIVE Keyword::
-* Popular Non-standard Types::
-* Full Support for Compiler Types::
-* Array Bounds Expressions::
-* POINTER Statements::
-* Sensible Non-standard Constructs::
-* READONLY Keyword::
-* FLUSH Statement::
-* Expressions in FORMAT Statements::
-* Explicit Assembler Code::
-* Q Edit Descriptor::
-
-GNU Fortran dialects:
-* Old-style PARAMETER Statements::
-* TYPE and ACCEPT I/O Statements::
-* STRUCTURE UNION RECORD MAP::
-* OPEN CLOSE and INQUIRE Keywords::
-* ENCODE and DECODE::
-* AUTOMATIC Statement::
-* Suppressing Space Padding::
-* Fortran Preprocessor::
-* Bit Operations on Floating-point Data::
-* Really Ugly Character Assignments::
-
-New facilities:
-* POSIX Standard::
-* Floating-point Exception Handling::
-* Nonportable Conversions::
-* Large Automatic Arrays::
-* Support for Threads::
-* Increasing Precision/Range::
-* Enabling Debug Lines::
-
-Better diagnostics:
-* Better Warnings::
-* Gracefully Handle Sensible Bad Code::
-* Non-standard Conversions::
-* Non-standard Intrinsics::
-* Modifying DO Variable::
-* Better Pedantic Compilation::
-* Warn About Implicit Conversions::
-* Invalid Use of Hollerith Constant::
-* Dummy Array Without Dimensioning Dummy::
-* Invalid FORMAT Specifiers::
-* Ambiguous Dialects::
-* Unused Labels::
-* Informational Messages::
-
-Run-time facilities:
-* Uninitialized Variables at Run Time::
-* Portable Unformatted Files::
-* Better List-directed I/O::
-* Default to Console I/O::
-
-Debugging:
-* Labels Visible to Debugger::
-@end menu
-
-@node Better Source Model
-@subsection Better Source Model
-
-@command{g77} needs to provide, as the default source-line model,
-a ``pure visual'' mode, where
-the interpretation of a source program in this mode can be accurately
-determined by a user looking at a traditionally displayed rendition
-of the program (assuming the user knows whether the program is fixed
-or free form).
-
-The design should assume the user cannot tell tabs from spaces
-and cannot see trailing spaces on lines, but has canonical tab stops
-and, for fixed-form source, has the ability to always know exactly
-where column 72 is (since the Fortran standard itself requires
-this for fixed-form source).
-
-This would change the default treatment of fixed-form source
-to not treat lines with tabs as if they were infinitely long---instead,
-they would end at column 72 just as if the tabs were replaced
-by spaces in the canonical way.
-
-As part of this, provide common alternate models (Digital, @command{f2c},
-and so on) via command-line options.
-This includes allowing arbitrarily long
-lines for free-form source as well as fixed-form source and providing
-various limits and diagnostics as appropriate.
-
-@cindex sequence numbers
-@cindex columns 73 through 80
-Also, @command{g77} should offer, perhaps even default to, warnings
-when characters beyond the last valid column are anything other
-than spaces.
-This would mean code with ``sequence numbers'' in columns 73 through 80
-would be rejected, and there's a lot of that kind of code around,
-but one of the most frequent bugs encountered by new users is
-accidentally writing fixed-form source code into and beyond
-column 73.
-So, maybe the users of old code would be able to more easily handle
-having to specify, say, a @option{-Wno-col73to80} option.
-
-@node Fortran 90 Support
-@subsection Fortran 90 Support
-@cindex Fortran 90, support
-@cindex support, Fortran 90
-
-@command{g77} does not support many of the features that
-distinguish Fortran 90 (and, now, Fortran 95) from
-ANSI FORTRAN 77.
-
-Some Fortran 90 features are supported, because they
-make sense to offer even to die-hard users of F77.
-For example, many of them codify various ways F77 has
-been extended to meet users' needs during its tenure,
-so @command{g77} might as well offer them as the primary
-way to meet those same needs, even if it offers compatibility
-with one or more of the ways those needs were met
-by other F77 compilers in the industry.
-
-Still, many important F90 features are not supported,
-because no attempt has been made to research each and
-every feature and assess its viability in @command{g77}.
-In the meantime, users who need those features must
-use Fortran 90 compilers anyway, and the best approach
-to adding some F90 features to GNU Fortran might well be
-to fund a comprehensive project to create GNU Fortran 95.
-
-@node Intrinsics in PARAMETER Statements
-@subsection Intrinsics in @code{PARAMETER} Statements
-@cindex PARAMETER statement
-@cindex statements, PARAMETER
-
-@command{g77} doesn't allow intrinsics in @code{PARAMETER} statements.
-
-Related to this, @command{g77} doesn't allow non-integral
-exponentiation in @code{PARAMETER} statements, such as
-@samp{PARAMETER (R=2**.25)}.
-It is unlikely @command{g77} will ever support this feature,
-as doing it properly requires complete emulation of
-a target computer's floating-point facilities when
-building @command{g77} as a cross-compiler.
-But, if the @command{gcc} back end is enhanced to provide
-such a facility, @command{g77} will likely use that facility
-in implementing this feature soon afterwards.
-
-@node Arbitrary Concatenation
-@subsection Arbitrary Concatenation
-@cindex concatenation
-@cindex CHARACTER*(*)
-@cindex run-time, dynamic allocation
-
-@command{g77} doesn't support arbitrary operands for concatenation
-in contexts where run-time allocation is required.
-For example:
-
-@smallexample
-SUBROUTINE X(A)
-CHARACTER*(*) A
-CALL FOO(A // 'suffix')
-@end smallexample
-
-@node SELECT CASE on CHARACTER Type
-@subsection @code{SELECT CASE} on @code{CHARACTER} Type
-
-Character-type selector/cases for @code{SELECT CASE} currently
-are not supported.
-
-@node RECURSIVE Keyword
-@subsection @code{RECURSIVE} Keyword
-@cindex RECURSIVE keyword
-@cindex keywords, RECURSIVE
-@cindex recursion, lack of
-@cindex lack of recursion
-
-@command{g77} doesn't support the @code{RECURSIVE} keyword that
-F90 compilers do.
-Nor does it provide any means for compiling procedures
-designed to do recursion.
-
-All recursive code can be rewritten to not use recursion,
-but the result is not pretty.
-
-@node Increasing Precision/Range
-@subsection Increasing Precision/Range
-@cindex -r8
-@cindex -qrealsize=8
-@cindex -i8
-@cindex f2c
-@cindex increasing precision
-@cindex precision, increasing
-@cindex increasing range
-@cindex range, increasing
-@cindex Toolpack
-@cindex Netlib
-
-Some compilers, such as @command{f2c}, have an option (@option{-r8},
-@option{-qrealsize=8} or
-similar) that provides automatic treatment of @code{REAL}
-entities such that they have twice the storage size, and
-a corresponding increase in the range and precision, of what
-would normally be the @code{REAL(KIND=1)} (default @code{REAL}) type.
-(This affects @code{COMPLEX} the same way.)
-
-They also typically offer another option (@option{-i8}) to increase
-@code{INTEGER} entities so they are twice as large
-(with roughly twice as much range).
-
-(There are potential pitfalls in using these options.)
-
-@command{g77} does not yet offer any option that performs these
-kinds of transformations.
-Part of the problem is the lack of detailed specifications regarding
-exactly how these options affect the interpretation of constants,
-intrinsics, and so on.
-
-Until @command{g77} addresses this need, programmers could improve
-the portability of their code by modifying it to not require
-compile-time options to produce correct results.
-Some free tools are available which may help, specifically
-in Toolpack (which one would expect to be sound) and the @file{fortran}
-section of the Netlib repository.
-
-Use of preprocessors can provide a fairly portable means
-to work around the lack of widely portable methods in the Fortran
-language itself (though increasing acceptance of Fortran 90 would
-alleviate this problem).
-
-@node Popular Non-standard Types
-@subsection Popular Non-standard Types
-@cindex @code{INTEGER*2} support
-@cindex types, @code{INTEGER*2}
-@cindex @code{LOGICAL*1} support
-@cindex types, @code{LOGICAL*1}
-
-@command{g77} doesn't fully support @code{INTEGER*2}, @code{LOGICAL*1},
-and similar.
-In the meantime, version 0.5.18 provides rudimentary support
-for them.
-
-@node Full Support for Compiler Types
-@subsection Full Support for Compiler Types
-
-@cindex @code{REAL*16} support
-@cindex types, @code{REAL*16}
-@cindex @code{INTEGER*8} support
-@cindex types, @code{INTEGER*8}
-@command{g77} doesn't support @code{INTEGER}, @code{REAL}, and @code{COMPLEX} equivalents
-for @emph{all} applicable back-end-supported types (@code{char}, @code{short int},
-@code{int}, @code{long int}, @code{long long int}, and @code{long double}).
-This means providing intrinsic support, and maybe constant
-support (using F90 syntax) as well, and, for most
-machines will result in automatic support of @code{INTEGER*1},
-@code{INTEGER*2}, @code{INTEGER*8}, maybe even @code{REAL*16},
-and so on.
-
-@node Array Bounds Expressions
-@subsection Array Bounds Expressions
-@cindex array elements, in adjustable array bounds
-@cindex function references, in adjustable array bounds
-@cindex array bounds, adjustable
-@cindex @code{DIMENSION} statement
-@cindex statements, @code{DIMENSION}
-
-@command{g77} doesn't support more general expressions to dimension
-arrays, such as array element references, function
-references, etc.
-
-For example, @command{g77} currently does not accept the following:
-
-@smallexample
-SUBROUTINE X(M, N)
-INTEGER N(10), M(N(2), N(1))
-@end smallexample
-
-@node POINTER Statements
-@subsection POINTER Statements
-@cindex POINTER statement
-@cindex statements, POINTER
-@cindex Cray pointers
-
-@command{g77} doesn't support pointers or allocatable objects
-(other than automatic arrays).
-This set of features is
-probably considered just behind intrinsics
-in @code{PARAMETER} statements on the list of large,
-important things to add to @command{g77}.
-
-In the meantime, consider using the @code{INTEGER(KIND=7)}
-declaration to specify that a variable must be
-able to hold a pointer.
-This construct is not portable to other non-GNU compilers,
-but it is portable to all machines GNU Fortran supports
-when @command{g77} is used.
-
-@xref{Functions and Subroutines}, for information on
-@code{%VAL()}, @code{%REF()}, and @code{%DESCR()}
-constructs, which are useful for passing pointers to
-procedures written in languages other than Fortran.
-
-@node Sensible Non-standard Constructs
-@subsection Sensible Non-standard Constructs
-
-@command{g77} rejects things other compilers accept,
-like @samp{INTRINSIC SQRT,SQRT}.
-As time permits in the future, some of these things that are easy for
-humans to read and write and unlikely to be intended to mean something
-else will be accepted by @command{g77} (though @option{-fpedantic} should
-trigger warnings about such non-standard constructs).
-
-Until @command{g77} no longer gratuitously rejects sensible code,
-you might as well fix your code
-to be more standard-conforming and portable.
-
-The kind of case that is important to except from the
-recommendation to change your code is one where following
-good coding rules would force you to write non-standard
-code that nevertheless has a clear meaning.
-
-For example, when writing an @code{INCLUDE} file that
-defines a common block, it might be appropriate to
-include a @code{SAVE} statement for the common block
-(such as @samp{SAVE /CBLOCK/}), so that variables
-defined in the common block retain their values even
-when all procedures declaring the common block become
-inactive (return to their callers).
-
-However, putting @code{SAVE} statements in an @code{INCLUDE}
-file would prevent otherwise standard-conforming code
-from also specifying the @code{SAVE} statement, by itself,
-to indicate that all local variables and arrays are to
-have the @code{SAVE} attribute.
-
-For this reason, @command{g77} already has been changed to
-allow this combination, because although the general
-problem of gratuitously rejecting unambiguous and
-``safe'' constructs still exists in @command{g77}, this
-particular construct was deemed useful enough that
-it was worth fixing @command{g77} for just this case.
-
-So, while there is no need to change your code
-to avoid using this particular construct, there
-might be other, equally appropriate but non-standard
-constructs, that you shouldn't have to stop using
-just because @command{g77} (or any other compiler)
-gratuitously rejects it.
-
-Until the general problem is solved, if you have
-any such construct you believe is worthwhile
-using (e.g. not just an arbitrary, redundant
-specification of an attribute), please submit a
-bug report with an explanation, so we can consider
-fixing @command{g77} just for cases like yours.
-
-@node READONLY Keyword
-@subsection @code{READONLY} Keyword
-@cindex READONLY
-
-Support for @code{READONLY}, in @code{OPEN} statements,
-requires @code{libg2c} support,
-to make sure that @samp{CLOSE(@dots{},STATUS='DELETE')}
-does not delete a file opened on a unit
-with the @code{READONLY} keyword,
-and perhaps to trigger a fatal diagnostic
-if a @code{WRITE} or @code{PRINT}
-to such a unit is attempted.
-
-@emph{Note:} It is not sufficient for @command{g77} and @code{libg2c}
-(its version of @code{libf2c})
-to assume that @code{READONLY} does not need some kind of explicit support
-at run time,
-due to UNIX systems not (generally) needing it.
-@command{g77} is not just a UNIX-based compiler!
-
-Further, mounting of non-UNIX filesystems on UNIX systems
-(such as via NFS)
-might require proper @code{READONLY} support.
-
-@cindex SHARED
-(Similar issues might be involved with supporting the @code{SHARED}
-keyword.)
-
-@node FLUSH Statement
-@subsection @code{FLUSH} Statement
-
-@command{g77} could perhaps use a @code{FLUSH} statement that
-does what @samp{CALL FLUSH} does,
-but that supports @samp{*} as the unit designator (same unit as for
-@code{PRINT}) and accepts @code{ERR=} and/or @code{IOSTAT=}
-specifiers.
-
-@node Expressions in FORMAT Statements
-@subsection Expressions in @code{FORMAT} Statements
-@cindex FORMAT statement
-@cindex statements, FORMAT
-
-@command{g77} doesn't support @samp{FORMAT(I<J>)} and the like.
-Supporting this requires a significant redesign or replacement
-of @code{libg2c}.
-
-However, @command{g77} does support
-this construct when the expression is constant
-(as of version 0.5.22).
-For example:
-
-@smallexample
-      PARAMETER (IWIDTH = 12)
-10    FORMAT (I<IWIDTH>)
-@end smallexample
-
-Otherwise, at least for output (@code{PRINT} and
-@code{WRITE}), Fortran code making use of this feature can
-be rewritten to avoid it by constructing the @code{FORMAT}
-string in a @code{CHARACTER} variable or array, then
-using that variable or array in place of the @code{FORMAT}
-statement label to do the original @code{PRINT} or @code{WRITE}.
-
-Many uses of this feature on input can be rewritten this way
-as well, but not all can.
-For example, this can be rewritten:
-
-@smallexample
-      READ 20, I
-20    FORMAT (I<J>)
-@end smallexample
-
-However, this cannot, in general, be rewritten, especially
-when @code{ERR=} and @code{END=} constructs are employed:
-
-@smallexample
-      READ 30, J, I
-30    FORMAT (I<J>)
-@end smallexample
-
-@node Explicit Assembler Code
-@subsection Explicit Assembler Code
-
-@command{g77} needs to provide some way, a la @command{gcc}, for @command{g77}
-code to specify explicit assembler code.
-
-@node Q Edit Descriptor
-@subsection Q Edit Descriptor
-@cindex FORMAT statement
-@cindex Q edit descriptor
-@cindex edit descriptor, Q
-
-The @code{Q} edit descriptor in @code{FORMAT}s isn't supported.
-(This is meant to get the number of characters remaining in an input record.)
-Supporting this requires a significant redesign or replacement
-of @code{libg2c}.
-
-A workaround might be using internal I/O or the stream-based intrinsics.
-@xref{FGetC Intrinsic (subroutine)}.
-
-@node Old-style PARAMETER Statements
-@subsection Old-style PARAMETER Statements
-@cindex PARAMETER statement
-@cindex statements, PARAMETER
-
-@command{g77} doesn't accept @samp{PARAMETER I=1}.
-Supporting this obsolete form of
-the @code{PARAMETER} statement would not be particularly hard, as most of the
-parsing code is already in place and working.
-
-Until time/money is
-spent implementing it, you might as well fix your code to use the
-standard form, @samp{PARAMETER (I=1)} (possibly needing
-@samp{INTEGER I} preceding the @code{PARAMETER} statement as well,
-otherwise, in the obsolete form of @code{PARAMETER}, the
-type of the variable is set from the type of the constant being
-assigned to it).
-
-@node TYPE and ACCEPT I/O Statements
-@subsection @code{TYPE} and @code{ACCEPT} I/O Statements
-@cindex TYPE statement
-@cindex statements, TYPE
-@cindex ACCEPT statement
-@cindex statements, ACCEPT
-
-@command{g77} doesn't support the I/O statements @code{TYPE} and
-@code{ACCEPT}.
-These are common extensions that should be easy to support,
-but also are fairly easy to work around in user code.
-
-Generally, any @samp{TYPE fmt,list} I/O statement can be replaced
-by @samp{PRINT fmt,list}.
-And, any @samp{ACCEPT fmt,list} statement can be
-replaced by @samp{READ fmt,list}.
-
-@node STRUCTURE UNION RECORD MAP
-@subsection @code{STRUCTURE}, @code{UNION}, @code{RECORD}, @code{MAP}
-@cindex STRUCTURE statement
-@cindex statements, STRUCTURE
-@cindex UNION statement
-@cindex statements, UNION
-@cindex RECORD statement
-@cindex statements, RECORD
-@cindex MAP statement
-@cindex statements, MAP
-
-@command{g77} doesn't support @code{STRUCTURE}, @code{UNION}, @code{RECORD},
-@code{MAP}.
-This set of extensions is quite a bit
-lower on the list of large, important things to add to @command{g77}, partly
-because it requires a great deal of work either upgrading or
-replacing @code{libg2c}.
-
-@node OPEN CLOSE and INQUIRE Keywords
-@subsection @code{OPEN}, @code{CLOSE}, and @code{INQUIRE} Keywords
-@cindex disposition of files
-@cindex OPEN statement
-@cindex statements, OPEN
-@cindex CLOSE statement
-@cindex statements, CLOSE
-@cindex INQUIRE statement
-@cindex statements, INQUIRE
-
-@command{g77} doesn't have support for keywords such as @code{DISP='DELETE'} in
-the @code{OPEN}, @code{CLOSE}, and @code{INQUIRE} statements.
-These extensions are easy to add to @command{g77} itself, but
-require much more work on @code{libg2c}.
-
-@cindex FORM='PRINT'
-@cindex ANS carriage control
-@cindex carriage control
-@pindex asa
-@pindex fpr
-@command{g77} doesn't support @code{FORM='PRINT'} or an equivalent to
-translate the traditional `carriage control' characters in column 1 of
-output to use backspaces, carriage returns and the like.  However
-programs exist to translate them in output files (or standard output).
-These are typically called either @command{fpr} or @command{asa}.  You can get
-a version of @command{asa} from
-@uref{ftp://sunsite.unc.edu/pub/Linux/devel/lang/fortran} for GNU
-systems which will probably build easily on other systems.
-Alternatively, @command{fpr} is in BSD distributions in various archive
-sites.
-
-@c (Can both programs can be used in a pipeline,
-@c with a named input file,
-@c and/or with a named output file???)
-
-@node ENCODE and DECODE
-@subsection @code{ENCODE} and @code{DECODE}
-@cindex ENCODE statement
-@cindex statements, ENCODE
-@cindex DECODE statement
-@cindex statements, DECODE
-
-@command{g77} doesn't support @code{ENCODE} or @code{DECODE}.
-
-These statements are best replaced by READ and WRITE statements
-involving internal files (CHARACTER variables and arrays).
-
-For example, replace a code fragment like
-
-@smallexample
-      INTEGER*1 LINE(80)
-@dots{}
-      DECODE (80, 9000, LINE) A, B, C
-@dots{}
-9000  FORMAT (1X, 3(F10.5))
-@end smallexample
-
-@noindent
-with:
-
-@smallexample
-      CHARACTER*80 LINE
-@dots{}
-      READ (UNIT=LINE, FMT=9000) A, B, C
-@dots{}
-9000  FORMAT (1X, 3(F10.5))
-@end smallexample
-
-Similarly, replace a code fragment like
-
-@smallexample
-      INTEGER*1 LINE(80)
-@dots{}
-      ENCODE (80, 9000, LINE) A, B, C
-@dots{}
-9000  FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
-@end smallexample
-
-@noindent
-with:
-
-@smallexample
-      CHARACTER*80 LINE
-@dots{}
-      WRITE (UNIT=LINE, FMT=9000) A, B, C
-@dots{}
-9000  FORMAT (1X, 'OUTPUT IS ', 3(F10.5))
-@end smallexample
-
-It is entirely possible that @code{ENCODE} and @code{DECODE} will
-be supported by a future version of @command{g77}.
-
-@node AUTOMATIC Statement
-@subsection @code{AUTOMATIC} Statement
-@cindex @code{AUTOMATIC} statement
-@cindex statements, @code{AUTOMATIC}
-@cindex automatic variables
-@cindex variables, automatic
-
-@command{g77} doesn't support the @code{AUTOMATIC} statement that
-@command{f2c} does.
-
-@code{AUTOMATIC} would identify a variable or array
-as not being @code{SAVE}'d, which is normally the default,
-but which would be especially useful for code that, @emph{generally},
-needed to be compiled with the @option{-fno-automatic} option.
-
-@code{AUTOMATIC} also would serve as a hint to the compiler that placing
-the variable or array---even a very large array--on the stack is acceptable.
-
-@code{AUTOMATIC} would not, by itself, designate the containing procedure
-as recursive.
-
-@code{AUTOMATIC} should work syntactically like @code{SAVE},
-in that @code{AUTOMATIC} with no variables listed should apply to
-all pertinent variables and arrays
-(which would not include common blocks or their members).
-
-Variables and arrays denoted as @code{AUTOMATIC}
-would not be permitted to be initialized via @code{DATA}
-or other specification of any initial values,
-requiring explicit initialization,
-such as via assignment statements.
-
-@cindex UNSAVE
-@cindex STATIC
-Perhaps @code{UNSAVE} and @code{STATIC},
-as strict semantic opposites to @code{SAVE} and @code{AUTOMATIC},
-should be provided as well.
-
-@node Suppressing Space Padding
-@subsection Suppressing Space Padding of Source Lines
-
-@command{g77} should offer VXT-Fortran-style suppression of virtual
-spaces at the end of a source line
-if an appropriate command-line option is specified.
-
-This affects cases where
-a character constant is continued onto the next line in a fixed-form
-source file, as in the following example:
-
-@smallexample
-10    PRINT *,'HOW MANY
-     1 SPACES?'
-@end smallexample
-
-@noindent
-@command{g77}, and many other compilers, virtually extend
-the continued line through column 72 with spaces that become part
-of the character constant, but Digital Fortran normally didn't,
-leaving only one space between @samp{MANY} and @samp{SPACES?}
-in the output of the above statement.
-
-Fairly recently, at least one version of Digital Fortran
-was enhanced to provide the other behavior when a
-command-line option is specified, apparently due to demand
-from readers of the USENET group @file{comp.lang.fortran}
-to offer conformance to this widespread practice in the
-industry.
-@command{g77} should return the favor by offering conformance
-to Digital's approach to handling the above example.
-
-@node Fortran Preprocessor
-@subsection Fortran Preprocessor
-
-@command{g77} should offer a preprocessor designed specifically
-for Fortran to replace @samp{cpp -traditional}.
-There are several out there worth evaluating, at least.
-
-Such a preprocessor would recognize Hollerith constants,
-properly parse comments and character constants, and so on.
-It might also recognize, process, and thus preprocess
-files included via the @code{INCLUDE} directive.
-
-@node Bit Operations on Floating-point Data
-@subsection Bit Operations on Floating-point Data
-@cindex @code{And} intrinsic
-@cindex intrinsics, @code{And}
-@cindex @code{Or} intrinsic
-@cindex intrinsics, @code{Or}
-@cindex @code{Shift} intrinsic
-@cindex intrinsics, @code{Shift}
-
-@command{g77} does not allow @code{REAL} and other non-integral types for
-arguments to intrinsics like @code{And}, @code{Or}, and @code{Shift}.
-
-For example, this program is rejected by @command{g77}, because
-the intrinsic @code{Iand} does not accept @code{REAL} arguments:
-
-@smallexample
-DATA A/7.54/, B/9.112/
-PRINT *, IAND(A, B)
-END
-@end smallexample
-
-@node Really Ugly Character Assignments
-@subsection Really Ugly Character Assignments
-
-An option such as @option{-fugly-char} should be provided
-to allow
-
-@smallexample
-REAL*8 A1
-DATA A1 / '12345678' /
-@end smallexample
-
-and:
-
-@smallexample
-REAL*8 A1
-A1 = 'ABCDEFGH'
-@end smallexample
-
-@node POSIX Standard
-@subsection @code{POSIX} Standard
-
-@command{g77} should support the POSIX standard for Fortran.
-
-@node Floating-point Exception Handling
-@subsection Floating-point Exception Handling
-@cindex floating-point, exceptions
-@cindex exceptions, floating-point
-@cindex FPE handling
-@cindex NaN values
-
-The @command{gcc} backend and, consequently, @command{g77}, currently provides no
-general control over whether or not floating-point exceptions are trapped or
-ignored.
-(Ignoring them typically results in NaN values being
-propagated in systems that conform to IEEE 754.)
-The behavior is normally inherited from the system-dependent startup
-code, though some targets, such as the Alpha, have code generation
-options which change the behavior.
-
-Most systems provide some C-callable mechanism to change this; this can
-be invoked at startup using @command{gcc}'s @code{constructor} attribute.
-For example, just compiling and linking the following C code with your
-program will turn on exception trapping for the ``common'' exceptions
-on a GNU system using glibc 2.2 or newer:
-
-@smallexample
-#define _GNU_SOURCE 1
-#include <fenv.h>
-static void __attribute__ ((constructor))
-trapfpe ()
-@{
-  /* Enable some exceptions.  At startup all exceptions are masked.  */
-  
-  feenableexcept (FE_INVALID|FE_DIVBYZERO|FE_OVERFLOW);
-@}
-@end smallexample
-
-A convenient trick is to compile this something like:
-@smallexample
-gcc -o libtrapfpe.a trapfpe.c
-@end smallexample
-and then use it by adding @option{-trapfpe} to the @command{g77} command line
-when linking.
-
-@node Nonportable Conversions
-@subsection Nonportable Conversions
-@cindex nonportable conversions
-@cindex conversions, nonportable
-
-@command{g77} doesn't accept some particularly nonportable,
-silent data-type conversions such as @code{LOGICAL}
-to @code{REAL} (as in @samp{A=.FALSE.}, where @samp{A}
-is type @code{REAL}), that other compilers might
-quietly accept.
-
-Some of these conversions are accepted by @command{g77}
-when the @option{-fugly-logint} option is specified.
-Perhaps it should accept more or all of them.
-
-@node Large Automatic Arrays
-@subsection Large Automatic Arrays
-@cindex automatic arrays
-@cindex arrays, automatic
-
-Currently, automatic arrays always are allocated on the stack.
-For situations where the stack cannot be made large enough,
-@command{g77} should offer a compiler option that specifies
-allocation of automatic arrays in heap storage.
-
-@node Support for Threads
-@subsection Support for Threads
-@cindex threads
-@cindex parallel processing
-
-Neither the code produced by @command{g77} nor the @code{libg2c} library
-are thread-safe, nor does @command{g77} have support for parallel processing
-(other than the instruction-level parallelism available on some
-processors).
-A package such as PVM might help here.
-
-@node Enabling Debug Lines
-@subsection Enabling Debug Lines
-@cindex debug line
-@cindex comment line, debug
-
-An option such as @option{-fdebug-lines} should be provided
-to turn fixed-form lines beginning with @samp{D}
-to be treated as if they began with a space,
-instead of as if they began with a @samp{C}
-(as comment lines).
-
-@node Better Warnings
-@subsection Better Warnings
-
-Because of how @command{g77} generates code via the back end,
-it doesn't always provide warnings the user wants.
-Consider:
-
-@smallexample
-PROGRAM X
-PRINT *, A
-END
-@end smallexample
-
-Currently, the above is not flagged as a case of
-using an uninitialized variable,
-because @command{g77} generates a run-time library call that looks,
-to the GBE, like it might actually @emph{modify} @samp{A} at run time.
-(And, in fact, depending on the previous run-time library call,
-it would!)
-
-Fixing this requires one of the following:
-
-@itemize @bullet
-@item
-Switch to new library, @code{libg77}, that provides
-a more ``clean'' interface,
-vis-a-vis input, output, and modified arguments,
-so the GBE can tell what's going on.
-
-This would provide a pretty big performance improvement,
-at least theoretically, and, ultimately, in practice,
-for some types of code.
-
-@item
-Have @command{g77} pass a pointer to a temporary
-containing a copy of @samp{A},
-instead of to @samp{A} itself.
-The GBE would then complain about the copy operation
-involving a potentially uninitialized variable.
-
-This might also provide a performance boost for some code,
-because @samp{A} might then end up living in a register,
-which could help with inner loops.
-
-@item
-Have @command{g77} use a GBE construct similar to @code{ADDR_EXPR}
-but with extra information on the fact that the
-item pointed to won't be modified
-(a la @code{const} in C).
-
-Probably the best solution for now, but not quite trivial
-to implement in the general case.
-@end itemize
-
-@node Gracefully Handle Sensible Bad Code
-@subsection Gracefully Handle Sensible Bad Code
-
-@command{g77} generally should continue processing for
-warnings and recoverable (user) errors whenever possible---that
-is, it shouldn't gratuitously make bad or useless code.
-
-For example:
-
-@smallexample
-INTRINSIC ZABS
-CALL FOO(ZABS)
-END
-@end smallexample
-
-@noindent
-When compiling the above with @option{-ff2c-intrinsics-disable},
-@command{g77} should indeed complain about passing @code{ZABS},
-but it still should compile, instead of rejecting
-the entire @code{CALL} statement.
-(Some of this is related to improving
-the compiler internals to improve how statements are analyzed.)
-
-@node Non-standard Conversions
-@subsection Non-standard Conversions
-
-@option{-Wconversion} and related should flag places where non-standard
-conversions are found.
-Perhaps much of this would be part of @option{-Wugly*}.
-
-@node Non-standard Intrinsics
-@subsection Non-standard Intrinsics
-
-@command{g77} needs a new option, like @option{-Wintrinsics}, to warn about use of
-non-standard intrinsics without explicit @code{INTRINSIC} statements for them.
-This would help find code that might fail silently when ported to another
-compiler.
-
-@node Modifying DO Variable
-@subsection Modifying @code{DO} Variable
-
-@command{g77} should warn about modifying @code{DO} variables
-via @code{EQUIVALENCE}.
-(The internal information gathered to produce this warning
-might also be useful in setting the
-internal ``doiter'' flag for a variable or even array
-reference within a loop, since that might produce faster code someday.)
-
-For example, this code is invalid, so @command{g77} should warn about
-the invalid assignment to @samp{NOTHER}:
-
-@smallexample
-EQUIVALENCE (I, NOTHER)
-DO I = 1, 100
-   IF (I.EQ. 10) NOTHER = 20
-END DO
-@end smallexample
-
-@node Better Pedantic Compilation
-@subsection Better Pedantic Compilation
-
-@command{g77} needs to support @option{-fpedantic} more thoroughly,
-and use it only to generate
-warnings instead of rejecting constructs outright.
-Have it warn:
-if a variable that dimensions an array is not a dummy or placed
-explicitly in @code{COMMON} (F77 does not allow it to be
-placed in @code{COMMON} via @code{EQUIVALENCE}); if specification statements
-follow statement-function-definition statements; about all sorts of
-syntactic extensions.
-
-@node Warn About Implicit Conversions
-@subsection Warn About Implicit Conversions
-
-@command{g77} needs a @option{-Wpromotions} option to warn if source code appears
-to expect automatic, silent, and
-somewhat dangerous compiler-assisted conversion of @code{REAL(KIND=1)}
-constants to @code{REAL(KIND=2)} based on context.
-
-For example, it would warn about cases like this:
-
-@smallexample
-DOUBLE PRECISION FOO
-PARAMETER (TZPHI = 9.435784839284958)
-FOO = TZPHI * 3D0
-@end smallexample
-
-@node Invalid Use of Hollerith Constant
-@subsection Invalid Use of Hollerith Constant
-
-@command{g77} should disallow statements like @samp{RETURN 2HAB},
-which are invalid in both source forms
-(unlike @samp{RETURN (2HAB)},
-which probably still makes no sense but at least can
-be reliably parsed).
-Fixed-form processing rejects it, but not free-form, except
-in a way that is a bit difficult to understand.
-
-@node Dummy Array Without Dimensioning Dummy
-@subsection Dummy Array Without Dimensioning Dummy
-
-@command{g77} should complain when a list of dummy arguments containing an
-adjustable dummy array does
-not also contain every variable listed in the dimension list of the
-adjustable array.
-
-Currently, @command{g77} does complain about a variable that
-dimensions an array but doesn't appear in any dummy list or @code{COMMON}
-area, but this needs to be extended to catch cases where it doesn't appear in
-every dummy list that also lists any arrays it dimensions.
-
-For example, @command{g77} should warn about the entry point @samp{ALT}
-below, since it includes @samp{ARRAY} but not @samp{ISIZE} in its
-list of arguments:
-
-@smallexample
-SUBROUTINE PRIMARY(ARRAY, ISIZE)
-REAL ARRAY(ISIZE)
-ENTRY ALT(ARRAY)
-@end smallexample
-
-@node Invalid FORMAT Specifiers
-@subsection Invalid FORMAT Specifiers
-
-@command{g77} should check @code{FORMAT} specifiers for validity
-as it does @code{FORMAT} statements.
-
-For example, a diagnostic would be produced for:
-
-@smallexample
-PRINT 'HI THERE!'  !User meant PRINT *, 'HI THERE!'
-@end smallexample
-
-@node Ambiguous Dialects
-@subsection Ambiguous Dialects
-
-@command{g77} needs a set of options such as @option{-Wugly*}, @option{-Wautomatic},
-@option{-Wvxt}, @option{-Wf90}, and so on.
-These would warn about places in the user's source where ambiguities
-are found, helpful in resolving ambiguities in the program's
-dialect or dialects.
-
-@node Unused Labels
-@subsection Unused Labels
-
-@command{g77} should warn about unused labels when @option{-Wunused} is in effect.
-
-@node Informational Messages
-@subsection Informational Messages
-
-@command{g77} needs an option to suppress information messages (notes).
-@option{-w} does this but also suppresses warnings.
-The default should be to suppress info messages.
-
-Perhaps info messages should simply be eliminated.
-
-@node Uninitialized Variables at Run Time
-@subsection Uninitialized Variables at Run Time
-
-@command{g77} needs an option to initialize everything (not otherwise
-explicitly initialized) to ``weird''
-(machine-dependent) values, e.g. NaNs, bad (non-@code{NULL}) pointers, and
-largest-magnitude integers, would help track down references to
-some kinds of uninitialized variables at run time.
-
-Note that use of the options @samp{-O -Wuninitialized} can catch
-many such bugs at compile time.
-
-@node Portable Unformatted Files
-@subsection Portable Unformatted Files
-
-@cindex unformatted files
-@cindex file formats
-@cindex binary data
-@cindex byte ordering
-@command{g77} has no facility for exchanging unformatted files with systems
-using different number formats---even differing only in endianness (byte
-order)---or written by other compilers.  Some compilers provide
-facilities at least for doing byte-swapping during unformatted I/O.
-
-It is unrealistic to expect to cope with exchanging unformatted files
-with arbitrary other compiler runtimes, but the @command{g77} runtime
-should at least be able to read files written by @command{g77} on systems
-with different number formats, particularly if they differ only in byte
-order.
-
-In case you do need to write a program to translate to or from
-@command{g77} (@code{libf2c}) unformatted files, they are written as
-follows:
-@table @asis
-@item Sequential
-Unformatted sequential records consist of
-@enumerate
-@item
-A number giving the length of the record contents;
-@item
-the length of record contents again (for backspace).
-@end enumerate
-
-The record length is of C type
-@code{long}; this means that it is 8 bytes on 64-bit systems such as
-Alpha GNU/Linux and 4 bytes on other systems, such as x86 GNU/Linux.
-Consequently such files cannot be exchanged between 64-bit and 32-bit
-systems, even with the same basic number format.
-@item Direct access
-Unformatted direct access files form a byte stream of length
-@var{records}*@var{recl} bytes, where @var{records} is the maximum
-record number (@code{REC=@var{records}}) written and @var{recl} is the
-record length in bytes specified in the @code{OPEN} statement
-(@code{RECL=@var{recl}}).  Data appear in the records as determined by
-the relevant @code{WRITE} statement.  Dummy records with arbitrary
-contents appear in the file in place of records which haven't been
-written.
-@end table
-
-Thus for exchanging a sequential or direct access unformatted file
-between big- and little-endian 32-bit systems using IEEE 754 floating
-point it would be sufficient to reverse the bytes in consecutive words
-in the file if, and @emph{only} if, only @code{REAL*4}, @code{COMPLEX},
-@code{INTEGER*4} and/or @code{LOGICAL*4} data have been written to it by
-@command{g77}.
-
-If necessary, it is possible to do byte-oriented i/o with @command{g77}'s
-@code{FGETC} and @code{FPUTC} intrinsics.  Byte-swapping can be done in
-Fortran by equivalencing larger sized variables to an @code{INTEGER*1}
-array or a set of scalars.
-
-@cindex HDF
-@cindex PDB
-If you need to exchange binary data between arbitrary system and
-compiler variations, we recommend using a portable binary format with
-Fortran bindings, such as NCSA's HDF (@uref{http://hdf.ncsa.uiuc.edu/})
-or PACT's PDB@footnote{No, not @emph{that} one.}
-(@uref{http://www.llnl.gov/def_sci/pact/pact_homepage.html}).  (Unlike,
-say, CDF or XDR, HDF-like systems write in the native number formats and
-only incur overhead when they are read on a system with a different
-format.)  A future @command{g77} runtime library should use such
-techniques.
-
-@node Better List-directed I/O
-@subsection Better List-directed I/O
-
-Values output using list-directed I/O
-(@samp{PRINT *, R, D})
-should be written with a field width, precision, and so on
-appropriate for the type (precision) of each value.
-
-(Currently, no distinction is made between single-precision
-and double-precision values
-by @code{libf2c}.)
-
-It is likely this item will require the @code{libg77} project
-to be undertaken.
-
-In the meantime, use of formatted I/O is recommended.
-While it might be of little consolation,
-@command{g77} does support @samp{FORMAT(F<WIDTH>.4)}, for example,
-as long as @samp{WIDTH} is defined as a named constant
-(via @code{PARAMETER}).
-That at least allows some compile-time specification
-of the precision of a data type,
-perhaps controlled by preprocessing directives.
-
-@node Default to Console I/O
-@subsection Default to Console I/O
-
-The default I/O units,
-specified by @samp{READ @var{fmt}},
-@samp{READ (UNIT=*)},
-@samp{WRITE (UNIT=*)}, and
-@samp{PRINT @var{fmt}},
-should not be units 5 (input) and 6 (output),
-but, rather, unit numbers not normally available
-for use in statements such as @code{OPEN} and @code{CLOSE}.
-
-Changing this would allow a program to connect units 5 and 6
-to files via @code{OPEN},
-but still use @samp{READ (UNIT=*)} and @samp{PRINT}
-to do I/O to the ``console''.
-
-This change probably requires the @code{libg77} project.
-
-@node Labels Visible to Debugger
-@subsection Labels Visible to Debugger
-
-@command{g77} should output debugging information for statements labels,
-for use by debuggers that know how to support them.
-Same with weirder things like construct names.
-It is not yet known if any debug formats or debuggers support these.
-
-@node Disappointments
-@section Disappointments and Misunderstandings
-
-These problems are perhaps regrettable, but we don't know any practical
-way around them for now.
-
-@menu
-* Mangling of Names::                       @samp{SUBROUTINE FOO} is given
-                                              external name @samp{foo_}.
-* Multiple Definitions of External Names::  No doing both @samp{COMMON /FOO/}
-                                              and @samp{SUBROUTINE FOO}.
-* Limitation on Implicit Declarations::     No @samp{IMPLICIT CHARACTER*(*)}.
-@end menu
-
-@node Mangling of Names
-@subsection Mangling of Names in Source Code
-@cindex naming issues
-@cindex external names
-@cindex common blocks
-@cindex name space
-@cindex underscore
-
-The current external-interface design, which includes naming of
-external procedures, COMMON blocks, and the library interface,
-has various usability problems, including things like adding
-underscores where not really necessary (and preventing easier
-inter-language operability) and yet not providing complete
-namespace freedom for user C code linked with Fortran apps (due
-to the naming of functions in the library, among other things).
-
-Project GNU should at least get all this ``right'' for systems
-it fully controls, such as the Hurd, and provide defaults and
-options for compatibility with existing systems and interoperability
-with popular existing compilers.
-
-@node Multiple Definitions of External Names
-@subsection Multiple Definitions of External Names
-@cindex block data
-@cindex BLOCK DATA statement
-@cindex statements, BLOCK DATA
-@cindex @code{COMMON} statement
-@cindex statements, @code{COMMON}
-@cindex naming conflicts
-
-@command{g77} doesn't allow a common block and an external procedure or
-@code{BLOCK DATA} to have the same name.
-Some systems allow this, but @command{g77} does not,
-to be compatible with @command{f2c}.
-
-@command{g77} could special-case the way it handles
-@code{BLOCK DATA}, since it is not compatible with @command{f2c} in this
-particular area (necessarily, since @command{g77} offers an
-important feature here), but
-it is likely that such special-casing would be very annoying to people
-with programs that use @samp{EXTERNAL FOO}, with no other mention of
-@samp{FOO} in the same program unit, to refer to external procedures, since
-the result would be that @command{g77} would treat these references as requests to
-force-load BLOCK DATA program units.
-
-In that case, if @command{g77} modified
-names of @code{BLOCK DATA} so they could have the same names as
-@code{COMMON}, users
-would find that their programs wouldn't link because the @samp{FOO} procedure
-didn't have its name translated the same way.
-
-(Strictly speaking,
-@command{g77} could emit a null-but-externally-satisfying definition of
-@samp{FOO} with its name transformed as if it had been a
-@code{BLOCK DATA}, but that probably invites more trouble than it's
-worth.)
-
-@node Limitation on Implicit Declarations
-@subsection Limitation on Implicit Declarations
-@cindex IMPLICIT CHARACTER*(*) statement
-@cindex statements, IMPLICIT CHARACTER*(*)
-
-@command{g77} disallows @code{IMPLICIT CHARACTER*(*)}.
-This is not standard-conforming.
-
-@node Non-bugs
-@section Certain Changes We Don't Want to Make
-
-This section lists changes that people frequently request, but which
-we do not make because we think GNU Fortran is better without them.
-
-@menu
-* Backslash in Constants::           Why @samp{'\\'} is a constant that
-                                       is one, not two, characters long.
-* Initializing Before Specifying::   Why @samp{DATA VAR/1/} can't precede
-                                       @samp{COMMON VAR}.
-* Context-Sensitive Intrinsicness::  Why @samp{CALL SQRT} won't work.
-* Context-Sensitive Constants::      Why @samp{9.435784839284958} is a
-                                       single-precision constant,
-                                       and might be interpreted as
-                                       @samp{9.435785} or similar.
-* Equivalence Versus Equality::      Why @samp{.TRUE. .EQ. .TRUE.} won't work.
-* Order of Side Effects::            Why @samp{J = IFUNC() - IFUNC()} might
-                                       not behave as expected.
-@end menu
-
-@node Backslash in Constants
-@subsection Backslash in Constants
-@cindex backslash
-@cindex @command{f77} support
-@cindex support, @command{f77}
-
-In the opinion of many experienced Fortran users,
-@option{-fno-backslash} should be the default, not @option{-fbackslash},
-as currently set by @command{g77}.
-
-First of all, you can always specify
-@option{-fno-backslash} to turn off this processing.
-
-Despite not being within the spirit (though apparently within the
-letter) of the ANSI FORTRAN 77 standard, @command{g77} defaults to
-@option{-fbackslash} because that is what most UNIX @command{f77} commands
-default to, and apparently lots of code depends on this feature.
-
-This is a particularly troubling issue.
-The use of a C construct in the midst of Fortran code
-is bad enough, worse when it makes existing Fortran
-programs stop working (as happens when programs written
-for non-UNIX systems are ported to UNIX systems with
-compilers that provide the @option{-fbackslash} feature
-as the default---sometimes with no option to turn it off).
-
-The author of GNU Fortran wished, for reasons of linguistic
-purity, to make @option{-fno-backslash} the default for GNU
-Fortran and thus require users of UNIX @command{f77} and @command{f2c}
-to specify @option{-fbackslash} to get the UNIX behavior.
-
-However, the realization that @command{g77} is intended as
-a replacement for @emph{UNIX} @command{f77}, caused the author
-to choose to make @command{g77} as compatible with
-@command{f77} as feasible, which meant making @option{-fbackslash}
-the default.
-
-The primary focus on compatibility is at the source-code
-level, and the question became ``What will users expect
-a replacement for @command{f77} to do, by default?''
-Although at least one UNIX @command{f77} does not provide
-@option{-fbackslash} as a default, it appears that
-the majority of them do, which suggests that
-the majority of code that is compiled by UNIX @command{f77}
-compilers expects @option{-fbackslash} to be the default.
-
-It is probably the case that more code exists
-that would @emph{not} work with @option{-fbackslash}
-in force than code that requires it be in force.
-
-However, most of @emph{that} code is not being compiled
-with @command{f77},
-and when it is, new build procedures (shell scripts,
-makefiles, and so on) must be set up anyway so that
-they work under UNIX.
-That makes a much more natural and safe opportunity for
-non-UNIX users to adapt their build procedures for
-@command{g77}'s default of @option{-fbackslash} than would
-exist for the majority of UNIX @command{f77} users who
-would have to modify existing, working build procedures
-to explicitly specify @option{-fbackslash} if that was
-not the default.
-
-One suggestion has been to configure the default for
-@option{-fbackslash} (and perhaps other options as well)
-based on the configuration of @command{g77}.
-
-This is technically quite straightforward, but will be avoided
-even in cases where not configuring defaults to be
-dependent on a particular configuration greatly inconveniences
-some users of legacy code.
-
-Many users appreciate the GNU compilers because they provide an
-environment that is uniform across machines.
-These users would be
-inconvenienced if the compiler treated things like the
-format of the source code differently on certain machines.
-
-Occasionally users write programs intended only for a particular machine
-type.
-On these occasions, the users would benefit if the GNU Fortran compiler
-were to support by default the same dialect as the other compilers on
-that machine.
-But such applications are rare.
-And users writing a
-program to run on more than one type of machine cannot possibly benefit
-from this kind of compatibility.
-(This is consistent with the design goals for @command{gcc}.
-To change them for @command{g77}, you must first change them
-for @command{gcc}.
-Do not ask the maintainers of @command{g77} to do this for you,
-or to disassociate @command{g77} from the widely understood, if
-not widely agreed-upon, goals for GNU compilers in general.)
-
-This is why GNU Fortran does and will treat backslashes in the same
-fashion on all types of machines (by default).
-@xref{Direction of Language Development}, for more information on
-this overall philosophy guiding the development of the GNU Fortran
-language.
-
-Of course, users strongly concerned about portability should indicate
-explicitly in their build procedures which options are expected
-by their source code, or write source code that has as few such
-expectations as possible.
-
-For example, avoid writing code that depends on backslash (@samp{\})
-being interpreted either way in particular, such as by
-starting a program unit with:
-
-@smallexample
-CHARACTER BACKSL
-PARAMETER (BACKSL = '\\')
-@end smallexample
-
-@noindent
-Then, use concatenation of @samp{BACKSL} anyplace a backslash
-is desired.
-In this way, users can write programs which have the same meaning
-in many Fortran dialects.
-
-(However, this technique does not work for Hollerith constants---which
-is just as well, since the only generally portable uses for Hollerith
-constants are in places where character constants can and should
-be used instead, for readability.)
-
-@node Initializing Before Specifying
-@subsection Initializing Before Specifying
-@cindex initialization, statement placement
-@cindex placing initialization statements
-
-@command{g77} does not allow @samp{DATA VAR/1/} to appear in the
-source code before @samp{COMMON VAR},
-@samp{DIMENSION VAR(10)}, @samp{INTEGER VAR}, and so on.
-In general, @command{g77} requires initialization of a variable
-or array to be specified @emph{after} all other specifications
-of attributes (type, size, placement, and so on) of that variable
-or array are specified (though @emph{confirmation} of data type is
-permitted).
-
-It is @emph{possible} @command{g77} will someday allow all of this,
-even though it is not allowed by the FORTRAN 77 standard.
-
-Then again, maybe it is better to have
-@command{g77} always require placement of @code{DATA}
-so that it can possibly immediately write constants
-to the output file, thus saving time and space.
-
-That is, @samp{DATA A/1000000*1/} should perhaps always
-be immediately writable to canonical assembler, unless it's already known
-to be in a @code{COMMON} area following as-yet-uninitialized stuff,
-and to do this it cannot be followed by @samp{COMMON A}.
-
-@node Context-Sensitive Intrinsicness
-@subsection Context-Sensitive Intrinsicness
-@cindex intrinsics, context-sensitive
-@cindex context-sensitive intrinsics
-
-@command{g77} treats procedure references to @emph{possible} intrinsic
-names as always enabling their intrinsic nature, regardless of
-whether the @emph{form} of the reference is valid for that
-intrinsic.
-
-For example, @samp{CALL SQRT} is interpreted by @command{g77} as
-an invalid reference to the @code{SQRT} intrinsic function,
-because the reference is a subroutine invocation.
-
-First, @command{g77} recognizes the statement @samp{CALL SQRT}
-as a reference to a @emph{procedure} named @samp{SQRT}, not
-to a @emph{variable} with that name (as it would for a statement
-such as @samp{V = SQRT}).
-
-Next, @command{g77} establishes that, in the program unit being compiled,
-@code{SQRT} is an intrinsic---not a subroutine that
-happens to have the same name as an intrinsic (as would be
-the case if, for example, @samp{EXTERNAL SQRT} was present).
-
-Finally, @command{g77} recognizes that the @emph{form} of the
-reference is invalid for that particular intrinsic.
-That is, it recognizes that it is invalid for an intrinsic
-@emph{function}, such as @code{SQRT}, to be invoked as
-a @emph{subroutine}.
-
-At that point, @command{g77} issues a diagnostic.
-
-Some users claim that it is ``obvious'' that @samp{CALL SQRT}
-references an external subroutine of their own, not an
-intrinsic function.
-
-However, @command{g77} knows about intrinsic
-subroutines, not just functions, and is able to support both having
-the same names, for example.
-
-As a result of this, @command{g77} rejects calls
-to intrinsics that are not subroutines, and function invocations
-of intrinsics that are not functions, just as it (and most compilers)
-rejects invocations of intrinsics with the wrong number (or types)
-of arguments.
-
-So, use the @samp{EXTERNAL SQRT} statement in a program unit that calls
-a user-written subroutine named @samp{SQRT}.
-
-@node Context-Sensitive Constants
-@subsection Context-Sensitive Constants
-@cindex constants, context-sensitive
-@cindex context-sensitive constants
-
-@command{g77} does not use context to determine the types of
-constants or named constants (@code{PARAMETER}), except
-for (non-standard) typeless constants such as @samp{'123'O}.
-
-For example, consider the following statement:
-
-@smallexample
-PRINT *, 9.435784839284958 * 2D0
-@end smallexample
-
-@noindent
-@command{g77} will interpret the (truncated) constant
-@samp{9.435784839284958} as a @code{REAL(KIND=1)}, not @code{REAL(KIND=2)},
-constant, because the suffix @code{D0} is not specified.
-
-As a result, the output of the above statement when
-compiled by @command{g77} will appear to have ``less precision''
-than when compiled by other compilers.
-
-In these and other cases, some compilers detect the
-fact that a single-precision constant is used in
-a double-precision context and therefore interpret the
-single-precision constant as if it was @emph{explicitly}
-specified as a double-precision constant.
-(This has the effect of appending @emph{decimal}, not
-@emph{binary}, zeros to the fractional part of the
-number---producing different computational results.)
-
-The reason this misfeature is dangerous is that a slight,
-apparently innocuous change to the source code can change
-the computational results.
-Consider:
-
-@smallexample
-REAL ALMOST, CLOSE
-DOUBLE PRECISION FIVE
-PARAMETER (ALMOST = 5.000000000001)
-FIVE = 5
-CLOSE = 5.000000000001
-PRINT *, 5.000000000001 - FIVE
-PRINT *, ALMOST - FIVE
-PRINT *, CLOSE - FIVE
-END
-@end smallexample
-
-@noindent
-Running the above program should
-result in the same value being
-printed three times.
-With @command{g77} as the compiler,
-it does.
-
-However, compiled by many other compilers,
-running the above program would print
-two or three distinct values, because
-in two or three of the statements, the
-constant @samp{5.000000000001}, which
-on most systems is exactly equal to @samp{5.}
-when interpreted as a single-precision constant,
-is instead interpreted as a double-precision
-constant, preserving the represented
-precision.
-However, this ``clever'' promotion of
-type does not extend to variables or,
-in some compilers, to named constants.
-
-Since programmers often are encouraged to replace manifest
-constants or permanently-assigned variables with named
-constants (@code{PARAMETER} in Fortran), and might need
-to replace some constants with variables having the same
-values for pertinent portions of code,
-it is important that compilers treat code so modified in the
-same way so that the results of such programs are the same.
-@command{g77} helps in this regard by treating constants just
-the same as variables in terms of determining their types
-in a context-independent way.
-
-Still, there is a lot of existing Fortran code that has
-been written to depend on the way other compilers freely
-interpret constants' types based on context, so anything
-@command{g77} can do to help flag cases of this in such code
-could be very helpful.
-
-@node Equivalence Versus Equality
-@subsection Equivalence Versus Equality
-@cindex .EQV., with integer operands
-@cindex comparing logical expressions
-@cindex logical expressions, comparing
-
-Use of @code{.EQ.} and @code{.NE.} on @code{LOGICAL} operands
-is not supported, except via @option{-fugly-logint}, which is not
-recommended except for legacy code (where the behavior expected
-by the @emph{code} is assumed).
-
-Legacy code should be changed, as resources permit, to use @code{.EQV.}
-and @code{.NEQV.} instead, as these are permitted by the various
-Fortran standards.
-
-New code should never be written expecting @code{.EQ.} or @code{.NE.}
-to work if either of its operands is @code{LOGICAL}.
-
-The problem with supporting this ``feature'' is that there is
-unlikely to be consensus on how it works, as illustrated by the
-following sample program:
-
-@smallexample
-LOGICAL L,M,N
-DATA L,M,N /3*.FALSE./
-IF (L.AND.M.EQ.N) PRINT *,'L.AND.M.EQ.N'
-END
-@end smallexample
-
-The issue raised by the above sample program is: what is the
-precedence of @code{.EQ.} (and @code{.NE.}) when applied to
-@code{LOGICAL} operands?
-
-Some programmers will argue that it is the same as the precedence
-for @code{.EQ.} when applied to numeric (such as @code{INTEGER})
-operands.
-By this interpretation, the subexpression @samp{M.EQ.N} must be
-evaluated first in the above program, resulting in a program that,
-when run, does not execute the @code{PRINT} statement.
-
-Other programmers will argue that the precedence is the same as
-the precedence for @code{.EQV.}, which is restricted by the standards
-to @code{LOGICAL} operands.
-By this interpretation, the subexpression @samp{L.AND.M} must be
-evaluated first, resulting in a program that @emph{does} execute
-the @code{PRINT} statement.
-
-Assigning arbitrary semantic interpretations to syntactic expressions
-that might legitimately have more than one ``obvious'' interpretation
-is generally unwise.
-
-The creators of the various Fortran standards have done a good job
-in this case, requiring a distinct set of operators (which have their
-own distinct precedence) to compare @code{LOGICAL} operands.
-This requirement results in expression syntax with more certain
-precedence (without requiring substantial context), making it easier
-for programmers to read existing code.
-@command{g77} will avoid muddying up elements of the Fortran language
-that were well-designed in the first place.
-
-(Ask C programmers about the precedence of expressions such as
-@samp{(a) & (b)} and @samp{(a) - (b)}---they cannot even tell
-you, without knowing more context, whether the @samp{&} and @samp{-}
-operators are infix (binary) or unary!)
-
-Most dangerous of all is the fact that,
-even assuming consensus on its meaning,
-an expression like @samp{L.AND.M.EQ.N},
-if it is the result of a typographical error,
-doesn't @emph{look} like it has such a typo.
-Even experienced Fortran programmers would not likely notice that
-@samp{L.AND.M.EQV.N} was, in fact, intended.
-
-So, this is a prime example of a circumstance in which
-a quality compiler diagnoses the code,
-instead of leaving it up to someone debugging it
-to know to turn on special compiler options
-that might diagnose it.
-
-@node Order of Side Effects
-@subsection Order of Side Effects
-@cindex side effects, order of evaluation
-@cindex order of evaluation, side effects
-
-@command{g77} does not necessarily produce code that, when run, performs
-side effects (such as those performed by function invocations)
-in the same order as in some other compiler---or even in the same
-order as another version, port, or invocation (using different
-command-line options) of @command{g77}.
-
-It is never safe to depend on the order of evaluation of side effects.
-For example, an expression like this may very well behave differently
-from one compiler to another:
-
-@smallexample
-J = IFUNC() - IFUNC()
-@end smallexample
-
-@noindent
-There is no guarantee that @samp{IFUNC} will be evaluated in any particular
-order.
-Either invocation might happen first.
-If @samp{IFUNC} returns 5 the first time it is invoked, and
-returns 12 the second time, @samp{J} might end up with the
-value @samp{7}, or it might end up with @samp{-7}.
-
-Generally, in Fortran, procedures with side-effects intended to
-be visible to the caller are best designed as @emph{subroutines},
-not functions.
-Examples of such side-effects include:
-
-@itemize @bullet
-@item
-The generation of random numbers
-that are intended to influence return values.
-
-@item
-Performing I/O
-(other than internal I/O to local variables).
-
-@item
-Updating information in common blocks.
-@end itemize
-
-An example of a side-effect that is not intended to be visible
-to the caller is a function that maintains a cache of recently
-calculated results, intended solely to speed repeated invocations
-of the function with identical arguments.
-Such a function can be safely used in expressions, because
-if the compiler optimizes away one or more calls to the
-function, operation of the program is unaffected (aside
-from being speeded up).
-
-@node Warnings and Errors
-@section Warning Messages and Error Messages
-
-@cindex error messages
-@cindex warnings vs errors
-@cindex messages, warning and error
-The GNU compiler can produce two kinds of diagnostics: errors and
-warnings.
-Each kind has a different purpose:
-
-@itemize @w{}
-@item
-@emph{Errors} report problems that make it impossible to compile your
-program.
-GNU Fortran reports errors with the source file name, line
-number, and column within the line where the problem is apparent.
-
-@item
-@emph{Warnings} report other unusual conditions in your code that
-@emph{might} indicate a problem, although compilation can (and does)
-proceed.
-Warning messages also report the source file name, line number,
-and column information,
-but include the text @samp{warning:} to distinguish them
-from error messages.
-@end itemize
-
-Warnings might indicate danger points where you should check to make sure
-that your program really does what you intend; or the use of obsolete
-features; or the use of nonstandard features of GNU Fortran.
-Many warnings are issued only if you ask for them, with one of the
-@option{-W} options (for instance, @option{-Wall} requests a variety of
-useful warnings).
-
-@emph{Note:} Currently, the text of the line and a pointer to the column
-is printed in most @command{g77} diagnostics.
-
-@xref{Warning Options,,Options to Request or Suppress Warnings}, for
-more detail on these and related command-line options.
-
-@node Open Questions
-@chapter Open Questions
-
-Please consider offering useful answers to these questions!
-
-@itemize @bullet
-@item
-@code{LOC()} and other intrinsics are probably somewhat misclassified.
-Is the a need for more precise classification of intrinsics, and if so,
-what are the appropriate groupings?
-Is there a need to individually
-enable/disable/delete/hide intrinsics from the command line?
-@end itemize
-
-@node Bugs
-@chapter Reporting Bugs
-@cindex bugs
-@cindex reporting bugs
-
-Your bug reports play an essential role in making GNU Fortran reliable.
-
-When you encounter a problem, the first thing to do is to see if it is
-already known.  @xref{Trouble}.  If it isn't known, then you should
-report the problem.
-
-@menu
-* Criteria: Bug Criteria.    Have you really found a bug?
-* Reporting: Bug Reporting.  How to report a bug effectively.
-@end menu
-
-@xref{Trouble,,Known Causes of Trouble with GNU Fortran},
-for information on problems we already know about.
-
-@xref{Service,,How To Get Help with GNU Fortran},
-for information on where to ask for help.
-
-@node Bug Criteria
-@section Have You Found a Bug?
-@cindex bug criteria
-
-If you are not sure whether you have found a bug, here are some guidelines:
-
-@itemize @bullet
-@cindex fatal signal
-@cindex core dump
-@item
-If the compiler gets a fatal signal, for any input whatever, that is a
-compiler bug.
-Reliable compilers never crash---they just remain obsolete.
-
-@cindex invalid assembly code
-@cindex assembly code, invalid
-@item
-If the compiler produces invalid assembly code, for any input whatever,
-@c (except an @code{asm} statement),
-that is a compiler bug, unless the
-compiler reports errors (not just warnings) which would ordinarily
-prevent the assembler from being run.
-
-@cindex undefined behavior
-@cindex undefined function value
-@item
-If the compiler produces valid assembly code that does not correctly
-execute the input source code, that is a compiler bug.
-
-However, you must double-check to make sure, because you might have run
-into an incompatibility between GNU Fortran and traditional Fortran.
-@c (@pxref{Incompatibilities}).
-These incompatibilities might be considered
-bugs, but they are inescapable consequences of valuable features.
-
-Or you might have a program whose behavior is undefined, which happened
-by chance to give the desired results with another Fortran compiler.
-It is best to check the relevant Fortran standard thoroughly if
-it is possible that the program indeed does something undefined.
-
-After you have localized the error to a single source line, it should
-be easy to check for these things.
-If your program is correct and well defined, you have found
-a compiler bug.
-
-It might help if, in your submission, you identified the specific
-language in the relevant Fortran standard that specifies the
-desired behavior, if it isn't likely to be obvious and agreed-upon
-by all Fortran users.
-
-@item
-If the compiler produces an error message for valid input, that is a
-compiler bug.
-
-@cindex invalid input
-@item
-If the compiler does not produce an error message for invalid input,
-that is a compiler bug.
-However, you should note that your idea of
-``invalid input'' might be someone else's idea
-of ``an extension'' or ``support for traditional practice''.
-
-@item
-If you are an experienced user of Fortran compilers, your suggestions
-for improvement of GNU Fortran are welcome in any case.
-@end itemize
-
-Many, perhaps most, bug reports against @command{g77} turn out to
-be bugs in the user's code.
-While we find such bug reports educational, they sometimes take
-a considerable amount of time to track down or at least respond
-to---time we could be spending making @command{g77}, not some user's
-code, better.
-
-Some steps you can take to verify that the bug is not certainly
-in the code you're compiling with @command{g77}:
-
-@itemize @bullet
-@item
-Compile your code using the @command{g77} options @samp{-W -Wall -O}.
-These options enable many useful warning; the @option{-O} option
-enables flow analysis that enables the uninitialized-variable
-warning.
-
-If you investigate the warnings and find evidence of possible bugs
-in your code, fix them first and retry @command{g77}.
-
-@item
-Compile your code using the @command{g77} options @option{-finit-local-zero},
-@option{-fno-automatic}, @option{-ffloat-store}, and various
-combinations thereof.
-
-If your code works with any of these combinations, that is not
-proof that the bug isn't in @command{g77}---a @command{g77} bug exposed
-by your code might simply be avoided, or have a different, more subtle
-effect, when different options are used---but it can be a
-strong indicator that your code is making unwarranted assumptions
-about the Fortran dialect and/or underlying machine it is
-being compiled and run on.
-
-@xref{Overly Convenient Options,,Overly Convenient Command-Line Options},
-for information on the @option{-fno-automatic} and
-@option{-finit-local-zero} options and how to convert
-their use into selective changes in your own code.
-
-@item
-@pindex ftnchek
-Validate your code with @command{ftnchek} or a similar code-checking
-tool.
-@command{ftnchek} can be found at @uref{ftp://ftp.netlib.org/fortran}
-or @uref{ftp://ftp.dsm.fordham.edu}.
-
-@pindex make
-@cindex Makefile example
-Here are some sample @file{Makefile} rules using @command{ftnchek}
-``project'' files to do cross-file checking and @command{sfmakedepend}
-(from @uref{ftp://ahab.rutgers.edu/pub/perl/sfmakedepend})
-to maintain dependencies automatically.
-These assume the use of GNU @command{make}.
-
-@smallexample
-# Dummy suffix for ftnchek targets:
-.SUFFIXES: .chek
-.PHONY: chekall
-
-# How to compile .f files (for implicit rule):
-FC = g77
-# Assume `include' directory:
-FFLAGS = -Iinclude -g -O -Wall
-
-# Flags for ftnchek:
-CHEK1 = -array=0 -include=includes -noarray
-CHEK2 = -nonovice -usage=1 -notruncation
-CHEKFLAGS = $(CHEK1) $(CHEK2)
-
-# Run ftnchek with all the .prj files except the one corresponding
-# to the target's root:
-%.chek : %.f ; \
-  ftnchek $(filter-out $*.prj,$(PRJS)) $(CHEKFLAGS) \
-    -noextern -library $<
-
-# Derive a project file from a source file:
-%.prj : %.f ; \
-  ftnchek $(CHEKFLAGS) -noextern -project -library $<
-
-# The list of objects is assumed to be in variable OBJS.
-# Sources corresponding to the objects:
-SRCS = $(OBJS:%.o=%.f)
-# ftnchek project files:
-PRJS = $(OBJS:%.o=%.prj)
-
-# Build the program
-prog: $(OBJS) ; \
-  $(FC) -o $@ $(OBJS)
-
-chekall: $(PRJS) ; \
-  ftnchek $(CHEKFLAGS) $(PRJS)
-
-prjs: $(PRJS)
-
-# For Emacs M-x find-tag:
-TAGS: $(SRCS) ; \
-  etags $(SRCS)
-
-# Rebuild dependencies:
-depend: ; \
-  sfmakedepend -I $(PLTLIBDIR) -I includes -a prj $(SRCS1)
-@end smallexample
-
-@item
-Try your code out using other Fortran compilers, such as @command{f2c}.
-If it does not work on at least one other compiler (assuming the
-compiler supports the features the code needs), that is a strong
-indicator of a bug in the code.
-
-However, even if your code works on many compilers @emph{except}
-@command{g77}, that does @emph{not} mean the bug is in @command{g77}.
-It might mean the bug is in your code, and that @command{g77} simply
-exposes it more readily than other compilers.
-@end itemize
-
-@node Bug Reporting
-@section How to Report Bugs
-@cindex compiler bugs, reporting
-
-Bugs should be reported to our bug database.  Please refer to
-@uref{http://gcc.gnu.org/bugs.html} for up-to-date instructions how to
-submit bug reports.  Copies of this file in HTML (@file{bugs.html}) and
-plain text (@file{BUGS}) are also part of GCC releases.
-
-
-@node Service
-@chapter How To Get Help with GNU Fortran
-
-If you need help installing, using or changing GNU Fortran, there are two
-ways to find it:
-
-@itemize @bullet
-@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
-GCC distribution.
-
-@item
-Send a message to @email{@value{email-help}}.
-@end itemize
-
-@end ifset
-@ifset INTERNALS
-@node Adding Options
-@chapter Adding Options
-@cindex options, adding
-@cindex adding options
-
-To add a new command-line option to @command{g77}, first decide
-what kind of option you wish to add.
-Search the @command{g77} and @command{gcc} documentation for one
-or more options that is most closely like the one you want to add
-(in terms of what kind of effect it has, and so on) to
-help clarify its nature.
-
-@itemize @bullet
-@item
-@emph{Fortran options} are options that apply only
-when compiling Fortran programs.
-They are accepted by @command{g77} and @command{gcc}, but
-they apply only when compiling Fortran programs.
-
-@item
-@emph{Compiler options} are options that apply
-when compiling most any kind of program.
-@end itemize
-
-@emph{Fortran options} are listed in the file
-@file{@value{path-g77}/lang-options.h},
-which is used during the build of @command{gcc} to
-build a list of all options that are accepted by
-at least one language's compiler.
-This list goes into the @code{documented_lang_options} array
-in @file{gcc/toplev.c}, which uses this array to
-determine whether a particular option should be
-offered to the linked-in front end for processing
-by calling @code{lang_option_decode}, which, for
-@command{g77}, is in @file{@value{path-g77}/com.c} and just
-calls @code{ffe_decode_option}.
-
-If the linked-in front end ``rejects'' a
-particular option passed to it, @file{toplev.c}
-just ignores the option, because @emph{some}
-language's compiler is willing to accept it.
-
-This allows commands like @samp{gcc -fno-asm foo.c bar.f}
-to work, even though Fortran compilation does
-not currently support the @option{-fno-asm} option;
-even though the @code{f771} version of @code{lang_decode_option}
-rejects @option{-fno-asm}, @file{toplev.c} doesn't
-produce a diagnostic because some other language (C)
-does accept it.
-
-This also means that commands like
-@samp{g77 -fno-asm foo.f} yield no diagnostics,
-despite the fact that no phase of the command was
-able to recognize and process @option{-fno-asm}---perhaps
-a warning about this would be helpful if it were
-possible.
-
-Code that processes Fortran options is found in
-@file{@value{path-g77}/top.c}, function @code{ffe_decode_option}.
-This code needs to check positive and negative forms
-of each option.
-
-The defaults for Fortran options are set in their
-global definitions, also found in @file{@value{path-g77}/top.c}.
-Many of these defaults are actually macros defined
-in @file{@value{path-g77}/target.h}, since they might be
-machine-specific.
-However, since, in practice, GNU compilers
-should behave the same way on all configurations
-(especially when it comes to language constructs),
-the practice of setting defaults in @file{target.h}
-is likely to be deprecated and, ultimately, stopped
-in future versions of @command{g77}.
-
-Accessor macros for Fortran options, used by code
-in the @command{g77} FFE, are defined in @file{@value{path-g77}/top.h}.
-
-@emph{Compiler options} are listed in @file{gcc/toplev.c}
-in the array @code{f_options}.
-An option not listed in @code{lang_options} is
-looked up in @code{f_options} and handled from there.
-
-The defaults for compiler options are set in the
-global definitions for the corresponding variables,
-some of which are in @file{gcc/toplev.c}.
-
-You can set different defaults for @emph{Fortran-oriented}
-or @emph{Fortran-reticent} compiler options by changing
-the source code of @command{g77} and rebuilding.
-How to do this depends on the version of @command{g77}:
-
-@table @code
-@item G77 0.5.24 (EGCS 1.1)
-@itemx G77 0.5.25 (EGCS 1.2 - which became GCC 2.95)
-Change the @code{lang_init_options} routine in @file{gcc/gcc/f/com.c}.
-
-(Note that these versions of @command{g77}
-perform internal consistency checking automatically
-when the @option{-fversion} option is specified.)
-
-@item G77 0.5.23
-@itemx G77 0.5.24 (EGCS 1.0)
-Change the way @code{f771} handles the @option{-fset-g77-defaults}
-option, which is always provided as the first option when
-called by @command{g77} or @command{gcc}.
-
-This code is in @code{ffe_decode_options} in @file{@value{path-g77}/top.c}.
-Have it change just the variables that you want to default
-to a different setting for Fortran compiles compared to
-compiles of other languages.
-
-The @option{-fset-g77-defaults} option is passed to @code{f771}
-automatically because of the specification information
-kept in @file{@value{path-g77}/lang-specs.h}.
-This file tells the @command{gcc} command how to recognize,
-in this case, Fortran source files (those to be preprocessed,
-and those that are not), and further, how to invoke the
-appropriate programs (including @code{f771}) to process
-those source files.
-
-It is in @file{@value{path-g77}/lang-specs.h} that @option{-fset-g77-defaults},
-@option{-fversion}, and other options are passed, as appropriate,
-even when the user has not explicitly specified them.
-Other ``internal'' options such as @option{-quiet} also
-are passed via this mechanism.
-@end table
-
-@node Projects
-@chapter Projects
-@cindex projects
-
-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.
-
-@menu
-* Efficiency::               Make @command{g77} itself compile code faster.
-* Better Optimization::      Teach @command{g77} to generate faster code.
-* Simplify Porting::         Make @command{g77} easier to configure, build,
-                             and install.
-* More Extensions::          Features many users won't know to ask for.
-* Machine Model::            @command{g77} should better leverage @command{gcc}.
-* Internals Documentation::  Make maintenance easier.
-* Internals Improvements::   Make internals more robust.
-* Better Diagnostics::       Make using @command{g77} on new code easier.
-@end menu
-
-@node Efficiency
-@section Improve Efficiency
-@cindex efficiency
-
-Don't bother doing any performance analysis until most of the
-following items are taken care of, because there's no question
-they represent serious space/time problems, although some of
-them show up only given certain kinds of (popular) input.
-
-@itemize @bullet
-@item
-Improve @code{malloc} package and its uses to specify more info about
-memory pools and, where feasible, use obstacks to implement them.
-
-@item
-Skip over uninitialized portions of aggregate areas (arrays,
-@code{COMMON} areas, @code{EQUIVALENCE} areas) so zeros need not be output.
-This would reduce memory usage for large initialized aggregate
-areas, even ones with only one initialized element.
-
-As of version 0.5.18, a portion of this item has already been
-accomplished.
-
-@item
-Prescan the statement (in @file{sta.c}) so that the nature of the statement
-is determined as much as possible by looking entirely at its form,
-and not looking at any context (previous statements, including types
-of symbols).
-This would allow ripping out of the statement-confirmation,
-symbol retraction/confirmation, and diagnostic inhibition
-mechanisms.
-Plus, it would result in much-improved diagnostics.
-For example, @samp{CALL some-intrinsic(@dots{})}, where the intrinsic
-is not a subroutine intrinsic, would result actual error instead of the
-unimplemented-statement catch-all.
-
-@item
-Throughout @command{g77}, don't pass line/column pairs where
-a simple @code{ffewhere} type, which points to the error as much as is
-desired by the configuration, will do, and don't pass @code{ffelexToken} types
-where a simple @code{ffewhere} type will do.
-Then, allow new default
-configuration of @code{ffewhere} such that the source line text is not
-preserved, and leave it to things like Emacs' next-error function
-to point to them (now that @samp{next-error} supports column,
-or, perhaps, character-offset, numbers).
-The change in calling sequences should improve performance somewhat,
-as should not having to save source lines.
-(Whether this whole
-item will improve performance is questionable, but it should
-improve maintainability.)
-
-@item
-Handle @samp{DATA (A(I),I=1,1000000)/1000000*2/} more efficiently, especially
-as regards the assembly output.
-Some of this might require improving
-the back end, but lots of improvement in space/time required in @command{g77}
-itself can be fairly easily obtained without touching the back end.
-Maybe type-conversion, where necessary, can be speeded up as well in
-cases like the one shown (converting the @samp{2} into @samp{2.}).
-
-@item
-If analysis shows it to be worthwhile, optimize @file{lex.c}.
-
-@item
-Consider redesigning @file{lex.c} to not need any feedback
-during tokenization, by keeping track of enough parse state on its
-own.
-@end itemize
-
-@node Better Optimization
-@section Better Optimization
-@cindex optimization, better
-@cindex code generation, improving
-
-Much of this work should be put off until after @command{g77} has
-all the features necessary for its widespread acceptance as a
-useful F77 compiler.
-However, perhaps this work can be done in parallel during
-the feature-adding work.
-
-@itemize @bullet
-@item
-Do the equivalent of the trick of putting @samp{extern inline} in front
-of every function definition in @code{libg2c} and #include'ing the resulting
-file in @command{f2c}+@command{gcc}---that is, inline all run-time-library functions
-that are at all worth inlining.
-(Some of this has already been done, such as for integral exponentiation.)
-
-@item
-When doing @samp{CHAR_VAR = CHAR_FUNC(@dots{})},
-and it's clear that types line up
-and @samp{CHAR_VAR} is addressable or not a @code{VAR_DECL},
-make @samp{CHAR_VAR}, not a
-temporary, be the receiver for @samp{CHAR_FUNC}.
-(This is now done for @code{COMPLEX} variables.)
-
-@item
-Design and implement Fortran-specific optimizations that don't
-really belong in the back end, or where the front end needs to
-give the back end more info than it currently does.
-
-@item
-Design and implement a new run-time library interface, with the
-code going into @code{libgcc} so no special linking is required to
-link Fortran programs using standard language features.
-This library
-would speed up lots of things, from I/O (using precompiled formats,
-doing just one, or, at most, very few, calls for arrays or array sections,
-and so on) to general computing (array/section implementations of
-various intrinsics, implementation of commonly performed loops that
-aren't likely to be optimally compiled otherwise, etc.).
-
-Among the important things the library would do are:
-
-@itemize @bullet
-@item
-Be a one-stop-shop-type
-library, hence shareable and usable by all, in that what are now
-library-build-time options in @code{libg2c} would be moved at least to the
-@command{g77} compile phase, if not to finer grains (such as choosing how
-list-directed I/O formatting is done by default at @code{OPEN} time, for
-preconnected units via options or even statements in the main program
-unit, maybe even on a per-I/O basis with appropriate pragma-like
-devices).
-@end itemize
-
-@item
-Probably requiring the new library design, change interface to
-normally have @code{COMPLEX} functions return their values in the way
-@command{gcc} would if they were declared @code{__complex__ float},
-rather than using
-the mechanism currently used by @code{CHARACTER} functions (whereby the
-functions are compiled as returning void and their first arg is
-a pointer to where to store the result).
-(Don't append underscores to
-external names for @code{COMPLEX} functions in some cases once @command{g77} uses
-@command{gcc} rather than @command{f2c} calling conventions.)
-
-@item
-Do something useful with @code{doiter} references where possible.
-For example, @samp{CALL FOO(I)} cannot modify @samp{I} if within
-a @code{DO} loop that uses @samp{I} as the
-iteration variable, and the back end might find that info useful
-in determining whether it needs to read @samp{I} back into a register after
-the call.
-(It normally has to do that, unless it knows @samp{FOO} never
-modifies its passed-by-reference argument, which is rarely the case
-for Fortran-77 code.)
-@end itemize
-
-@node Simplify Porting
-@section Simplify Porting
-@cindex porting, simplify
-@cindex simplify porting
-
-Making @command{g77} easier to configure, port, build, and install, either
-as a single-system compiler or as a cross-compiler, would be
-very useful.
-
-@itemize @bullet
-@item
-A new library (replacing @code{libg2c}) should improve portability as well as
-produce more optimal code.
-Further, @command{g77} and the new library should
-conspire to simplify naming of externals, such as by removing unnecessarily
-added underscores, and to reduce/eliminate the possibility of naming
-conflicts, while making debugger more straightforward.
-
-Also, it should
-make multi-language applications more feasible, such as by providing
-Fortran intrinsics that get Fortran unit numbers given C @code{FILE *}
-descriptors.
-
-@item
-Possibly related to a new library, @command{g77} should produce the equivalent
-of a @command{gcc} @samp{main(argc, argv)} function when it compiles a
-main program unit, instead of compiling something that must be
-called by a library
-implementation of @code{main()}.
-
-This would do many useful things such as
-provide more flexibility in terms of setting up exception handling,
-not requiring programmers to start their debugging sessions with
-@kbd{breakpoint MAIN__} followed by @kbd{run}, and so on.
-
-@item
-The GBE needs to understand the difference between alignment
-requirements and desires.
-For example, on Intel x86 machines, @command{g77} currently imposes
-overly strict alignment requirements, due to the back end, but it
-would be useful for Fortran and C programmers to be able to override
-these @emph{recommendations} as long as they don't violate the actual
-processor @emph{requirements}.
-@end itemize
-
-@node More Extensions
-@section More Extensions
-@cindex extensions, more
-
-These extensions are not the sort of things users ask for ``by name'',
-but they might improve the usability of @command{g77}, and Fortran in
-general, in the long run.
-Some of these items really pertain to improving @command{g77} internals
-so that some popular extensions can be more easily supported.
-
-@itemize @bullet
-@item
-Look through all the documentation on the GNU Fortran language,
-dialects, compiler, missing features, bugs, and so on.
-Many mentions of incomplete or missing features are
-sprinkled throughout.
-It is not worth repeating them here.
-
-@item
-Consider adding a @code{NUMERIC} type to designate typeless numeric constants,
-named and unnamed.
-The idea is to provide a forward-looking, effective
-replacement for things like the old-style @code{PARAMETER} statement
-when people
-really need typelessness in a maintainable, portable, clearly documented
-way.
-Maybe @code{TYPELESS} would include @code{CHARACTER}, @code{POINTER},
-and whatever else might come along.
-(This is not really a call for polymorphism per se, just
-an ability to express limited, syntactic polymorphism.)
-
-@item
-Support @samp{OPEN(@dots{},KEY=(@dots{}),@dots{})}.
-
-@item
-Support arbitrary file unit numbers, instead of limiting them
-to 0 through @samp{MXUNIT-1}.
-(This is a @code{libg2c} issue.)
-
-@item
-@samp{OPEN(NOSPANBLOCKS,@dots{})} is treated as
-@samp{OPEN(UNIT=NOSPANBLOCKS,@dots{})}, so a
-later @code{UNIT=} in the first example is invalid.
-Make sure this is what users of this feature would expect.
-
-@item
-Currently @command{g77} disallows @samp{READ(1'10)} since
-it is an obnoxious syntax, but
-supporting it might be pretty easy if needed.
-More details are needed, such
-as whether general expressions separated by an apostrophe are supported,
-or maybe the record number can be a general expression, and so on.
-
-@item
-Support @code{STRUCTURE}, @code{UNION}, @code{MAP}, and @code{RECORD}
-fully.
-Currently there is no support at all
-for @code{%FILL} in @code{STRUCTURE} and related syntax,
-whereas the rest of the
-stuff has at least some parsing support.
-This requires either major
-changes to @code{libg2c} or its replacement.
-
-@item
-F90 and @command{g77} probably disagree about label scoping relative to
-@code{INTERFACE} and @code{END INTERFACE}, and their contained
-procedure interface bodies (blocks?).
-
-@item
-@code{ENTRY} doesn't support F90 @code{RESULT()} yet,
-since that was added after S8.112.
-
-@item
-Empty-statement handling (10 ;;CONTINUE;;) probably isn't consistent
-with the final form of the standard (it was vague at S8.112).
-
-@item
-It seems to be an ``open'' question whether a file, immediately after being
-@code{OPEN}ed,is positioned at the beginning, the end, or wherever---it
-might be nice to offer an option of opening to ``undefined'' status, requiring
-an explicit absolute-positioning operation to be performed before any
-other (besides @code{CLOSE}) to assist in making applications port to systems
-(some IBM?) that @code{OPEN} to the end of a file or some such thing.
-@end itemize
-
-@node Machine Model
-@section Machine Model
-
-This items pertain to generalizing @command{g77}'s view of
-the machine model to more fully accept whatever the GBE
-provides it via its configuration.
-
-@itemize @bullet
-@item
-Switch to using @code{REAL_VALUE_TYPE} to represent floating-point constants
-exclusively so the target float format need not be required.
-This
-means changing the way @command{g77} handles initialization of aggregate areas
-having more than one type, such as @code{REAL} and @code{INTEGER},
-because currently
-it initializes them as if they were arrays of @code{char} and uses the
-bit patterns of the constants of the various types in them to determine
-what to stuff in elements of the arrays.
-
-@item
-Rely more and more on back-end info and capabilities, especially in the
-area of constants (where having the @command{g77} front-end's IL just store
-the appropriate tree nodes containing constants might be best).
-
-@item
-Suite of C and Fortran programs that a user/administrator can run on a
-machine to help determine the configuration for @command{g77} before building
-and help determine if the compiler works (especially with whatever
-libraries are installed) after building.
-@end itemize
-
-@node Internals Documentation
-@section Internals Documentation
-
-Better info on how @command{g77} works and how to port it is needed.
-
-@xref{Front End}, which contains some information
-on @command{g77} internals.
-
-@node Internals Improvements
-@section Internals Improvements
-
-Some more items that would make @command{g77} more reliable
-and easier to maintain:
-
-@itemize @bullet
-@item
-Generally make expression handling focus
-more on critical syntax stuff, leaving semantics to callers.
-For example,
-anything a caller can check, semantically, let it do so, rather
-than having @file{expr.c} do it.
-(Exceptions might include things like
-diagnosing @samp{FOO(I--K:)=BAR} where @samp{FOO} is a @code{PARAMETER}---if
-it seems
-important to preserve the left-to-right-in-source order of production
-of diagnostics.)
-
-@item
-Come up with better naming conventions for @option{-D} to establish requirements
-to achieve desired implementation dialect via @file{proj.h}.
-
-@item
-Clean up used tokens and @code{ffewhere}s in @code{ffeglobal_terminate_1}.
-
-@item
-Replace @file{sta.c} @code{outpooldisp} mechanism with @code{malloc_pool_use}.
-
-@item
-Check for @code{opANY} in more places in @file{com.c}, @file{std.c},
-and @file{ste.c}, and get rid of the @samp{opCONVERT(opANY)} kludge
-(after determining if there is indeed no real need for it).
-
-@item
-Utility to read and check @file{bad.def} messages and their references in the
-code, to make sure calls are consistent with message templates.
-
-@item
-Search and fix @samp{&ffe@dots{}} and similar so that
-@samp{ffe@dots{}ptr@dots{}} macros are
-available instead (a good argument for wishing this could have written all
-this stuff in C++, perhaps).
-On the other hand, it's questionable whether this sort of
-improvement is really necessary, given the availability of
-tools such as Emacs and Perl, which make finding any
-address-taking of structure members easy enough?
-
-@item
-Some modules truly export the member names of their structures (and the
-structures themselves), maybe fix this, and fix other modules that just
-appear to as well (by appending @samp{_}, though it'd be ugly and probably
-not worth the time).
-
-@item
-Implement C macros @samp{RETURNS(value)} and @samp{SETS(something,value)}
-in @file{proj.h}
-and use them throughout @command{g77} source code (especially in the definitions
-of access macros in @samp{.h} files) so they can be tailored
-to catch code writing into a @samp{RETURNS()} or reading from a @samp{SETS()}.
-
-@item
-Decorate throughout with @code{const} and other such stuff.
-
-@item
-All F90 notational derivations in the source code are still based
-on the S8.112 version of the draft standard.
-Probably should update
-to the official standard, or put documentation of the rules as used
-in the code@dots{}uh@dots{}in the code.
-
-@item
-Some @code{ffebld_new} calls (those outside of @file{ffeexpr.c} or
-inside but invoked via paths not involving @code{ffeexpr_lhs} or
-@code{ffeexpr_rhs}) might be creating things
-in improper pools, leading to such things staying around too long or
-(doubtful, but possible and dangerous) not long enough.
-
-@item
-Some @code{ffebld_list_new} (or whatever) calls might not be matched by
-@code{ffebld_list_bottom} (or whatever) calls, which might someday matter.
-(It definitely is not a problem just yet.)
-
-@item
-Probably not doing clean things when we fail to @code{EQUIVALENCE} something
-due to alignment/mismatch or other problems---they end up without
-@code{ffestorag} objects, so maybe the backend (and other parts of the front
-end) can notice that and handle like an @code{opANY} (do what it wants, just
-don't complain or crash).
-Most of this seems to have been addressed
-by now, but a code review wouldn't hurt.
-@end itemize
-
-@node Better Diagnostics
-@section Better Diagnostics
-
-These are things users might not ask about, or that need to
-be looked into, before worrying about.
-Also here are items that involve reducing unnecessary diagnostic
-clutter.
-
-@itemize @bullet
-@item
-When @code{FUNCTION} and @code{ENTRY} point types disagree (@code{CHARACTER}
-lengths, type classes, and so on),
-@code{ANY}-ize the offending @code{ENTRY} point and any @emph{new} dummies
-it specifies.
-
-@item
-Speed up and improve error handling for data when repeat-count is
-specified.
-For example, don't output 20 unnecessary messages after the
-first necessary one for:
-
-@smallexample
-INTEGER X(20)
-CONTINUE
-DATA (X(I), J= 1, 20) /20*5/
-END
-@end smallexample
-
-@noindent
-(The @code{CONTINUE} statement ensures the @code{DATA} statement
-is processed in the context of executable, not specification,
-statements.)
-@end itemize
-
-@include ffe.texi
-
-@end ifset
-
-@ifset USING
-@node Diagnostics
-@chapter Diagnostics
-@cindex diagnostics
-
-Some diagnostics produced by @command{g77} require sufficient explanation
-that the explanations are given below, and the diagnostics themselves
-identify the appropriate explanation.
-
-Identification uses the GNU Info format---specifically, the @command{info}
-command that displays the explanation is given within square
-brackets in the diagnostic.
-For example:
-
-@smallexample
-foo.f:5: Invalid statement [info -f g77 M FOOEY]
-@end smallexample
-
-More details about the above diagnostic is found in the @command{g77} Info
-documentation, menu item @samp{M}, submenu item @samp{FOOEY},
-which is displayed by typing the UNIX command
-@samp{info -f g77 M FOOEY}.
-
-Other Info readers, such as EMACS, may be just as easily used to display
-the pertinent node.
-In the above example, @samp{g77} is the Info document name,
-@samp{M} is the top-level menu item to select,
-and, in that node (named @samp{Diagnostics}, the name of
-this chapter, which is the very text you're reading now),
-@samp{FOOEY} is the menu item to select.
-
-@iftex
-In this printed version of the @command{g77} manual, the above example
-points to a section, below, entitled @samp{FOOEY}---though, of course,
-as the above is just a sample, no such section exists.
-@end iftex
-
-@menu
-* CMPAMBIG::    Ambiguous use of intrinsic.
-* EXPIMP::      Intrinsic used explicitly and implicitly.
-* INTGLOB::     Intrinsic also used as name of global.
-* LEX::         Various lexer messages
-* GLOBALS::     Disagreements about globals.
-* LINKFAIL::    When linking @code{f771} fails.
-* Y2KBAD::      Use of non-Y2K-compliant intrinsic.
-@end menu
-
-@node CMPAMBIG
-@section @code{CMPAMBIG}
-
-@noindent
-@smallexample
-Ambiguous use of intrinsic @var{intrinsic} @dots{}
-@end smallexample
-
-The type of the argument to the invocation of the @var{intrinsic}
-intrinsic is a @code{COMPLEX} type other than @code{COMPLEX(KIND=1)}.
-Typically, it is @code{COMPLEX(KIND=2)}, also known as
-@code{DOUBLE COMPLEX}.
-
-The interpretation of this invocation depends on the particular
-dialect of Fortran for which the code was written.
-Some dialects convert the real part of the argument to
-@code{REAL(KIND=1)}, thus losing precision; other dialects,
-and Fortran 90, do no such conversion.
-
-So, GNU Fortran rejects such invocations except under certain
-circumstances, to avoid making an incorrect assumption that results
-in generating the wrong code.
-
-To determine the dialect of the program unit, perhaps even whether
-that particular invocation is properly coded, determine how the
-result of the intrinsic is used.
-
-The result of @var{intrinsic} is expected (by the original programmer)
-to be @code{REAL(KIND=1)} (the non-Fortran-90 interpretation) if:
-
-@itemize @bullet
-@item
-It is passed as an argument to a procedure that explicitly or
-implicitly declares that argument @code{REAL(KIND=1)}.
-
-For example,
-a procedure with no @code{DOUBLE PRECISION} or @code{IMPLICIT DOUBLE PRECISION}
-statement specifying the dummy argument corresponding to an
-actual argument of @samp{REAL(Z)}, where @samp{Z} is declared
-@code{DOUBLE COMPLEX}, strongly suggests that the programmer
-expected @samp{REAL(Z)} to return @code{REAL(KIND=1)} instead
-of @code{REAL(KIND=2)}.
-
-@item
-It is used in a context that would otherwise not include
-any @code{REAL(KIND=2)} but where treating the @var{intrinsic}
-invocation as @code{REAL(KIND=2)} would result in unnecessary
-promotions and (typically) more expensive operations on the
-wider type.
-
-For example:
-
-@smallexample
-DOUBLE COMPLEX Z
-@dots{}
-R(1) = T * REAL(Z)
-@end smallexample
-
-The above example suggests the programmer expected the real part
-of @samp{Z} to be converted to @code{REAL(KIND=1)} before being
-multiplied by @samp{T} (presumed, along with @samp{R} above, to
-be type @code{REAL(KIND=1)}).
-
-Otherwise, the conversion would have to be delayed until after
-the multiplication, requiring not only an extra conversion
-(of @samp{T} to @code{REAL(KIND=2)}), but a (typically) more
-expensive multiplication (a double-precision multiplication instead
-of a single-precision one).
-@end itemize
-
-The result of @var{intrinsic} is expected (by the original programmer)
-to be @code{REAL(KIND=2)} (the Fortran 90 interpretation) if:
-
-@itemize @bullet
-@item
-It is passed as an argument to a procedure that explicitly or
-implicitly declares that argument @code{REAL(KIND=2)}.
-
-For example, a procedure specifying a @code{DOUBLE PRECISION}
-dummy argument corresponding to an
-actual argument of @samp{REAL(Z)}, where @samp{Z} is declared
-@code{DOUBLE COMPLEX}, strongly suggests that the programmer
-expected @samp{REAL(Z)} to return @code{REAL(KIND=2)} instead
-of @code{REAL(KIND=1)}.
-
-@item
-It is used in an expression context that includes
-other @code{REAL(KIND=2)} operands,
-or is assigned to a @code{REAL(KIND=2)} variable or array element.
-
-For example:
-
-@smallexample
-DOUBLE COMPLEX Z
-DOUBLE PRECISION R, T
-@dots{}
-R(1) = T * REAL(Z)
-@end smallexample
-
-The above example suggests the programmer expected the real part
-of @samp{Z} to @emph{not} be converted to @code{REAL(KIND=1)}
-by the @code{REAL()} intrinsic.
-
-Otherwise, the conversion would have to be immediately followed
-by a conversion back to @code{REAL(KIND=2)}, losing
-the original, full precision of the real part of @code{Z},
-before being multiplied by @samp{T}.
-@end itemize
-
-Once you have determined whether a particular invocation of @var{intrinsic}
-expects the Fortran 90 interpretation, you can:
-
-@itemize @bullet
-@item
-Change it to @samp{DBLE(@var{expr})} (if @var{intrinsic} is
-@code{REAL}) or @samp{DIMAG(@var{expr})} (if @var{intrinsic}
-is @code{AIMAG})
-if it expected the Fortran 90 interpretation.
-
-This assumes @var{expr} is @code{COMPLEX(KIND=2)}---if it is
-some other type, such as @code{COMPLEX*32}, you should use the
-appropriate intrinsic, such as the one to convert to @code{REAL*16}
-(perhaps @code{DBLEQ()} in place of @code{DBLE()}, and
-@code{QIMAG()} in place of @code{DIMAG()}).
-
-@item
-Change it to @samp{REAL(@var{intrinsic}(@var{expr}))},
-otherwise.
-This converts to @code{REAL(KIND=1)} in all working
-Fortran compilers.
-@end itemize
-
-If you don't want to change the code, and you are certain that all
-ambiguous invocations of @var{intrinsic} in the source file have
-the same expectation regarding interpretation, you can:
-
-@itemize @bullet
-@item
-Compile with the @command{g77} option @option{-ff90}, to enable the
-Fortran 90 interpretation.
-
-@item
-Compile with the @command{g77} options @samp{-fno-f90 -fugly-complex},
-to enable the non-Fortran-90 interpretations.
-@end itemize
-
-@xref{REAL() and AIMAG() of Complex}, for more information on this
-issue.
-
-Note: If the above suggestions don't produce enough evidence
-as to whether a particular program expects the Fortran 90
-interpretation of this ambiguous invocation of @var{intrinsic},
-there is one more thing you can try.
-
-If you have access to most or all the compilers used on the
-program to create successfully tested and deployed executables,
-read the documentation for, and @emph{also} test out, each compiler
-to determine how it treats the @var{intrinsic} intrinsic in
-this case.
-(If all the compilers don't agree on an interpretation, there
-might be lurking bugs in the deployed versions of the program.)
-
-The following sample program might help:
-
-@cindex JCB003 program
-@smallexample
-      PROGRAM JCB003
-C
-C Written by James Craig Burley 1997-02-23.
-C
-C Determine how compilers handle non-standard REAL
-C and AIMAG on DOUBLE COMPLEX operands.
-C
-      DOUBLE COMPLEX Z
-      REAL R
-      Z = (3.3D0, 4.4D0)
-      R = Z
-      CALL DUMDUM(Z, R)
-      R = REAL(Z) - R
-      IF (R .NE. 0.) PRINT *, 'REAL() is Fortran 90'
-      IF (R .EQ. 0.) PRINT *, 'REAL() is not Fortran 90'
-      R = 4.4D0
-      CALL DUMDUM(Z, R)
-      R = AIMAG(Z) - R
-      IF (R .NE. 0.) PRINT *, 'AIMAG() is Fortran 90'
-      IF (R .EQ. 0.) PRINT *, 'AIMAG() is not Fortran 90'
-      END
-C
-C Just to make sure compiler doesn't use naive flow
-C analysis to optimize away careful work above,
-C which might invalidate results....
-C
-      SUBROUTINE DUMDUM(Z, R)
-      DOUBLE COMPLEX Z
-      REAL R
-      END
-@end smallexample
-
-If the above program prints contradictory results on a
-particular compiler, run away!
-
-@node EXPIMP
-@section @code{EXPIMP}
-
-@noindent
-@smallexample
-Intrinsic @var{intrinsic} referenced @dots{}
-@end smallexample
-
-The @var{intrinsic} is explicitly declared in one program
-unit in the source file and implicitly used as an intrinsic
-in another program unit in the same source file.
-
-This diagnostic is designed to catch cases where a program
-might depend on using the name @var{intrinsic} as an intrinsic
-in one program unit and as a global name (such as the name
-of a subroutine or function) in another, but @command{g77} recognizes
-the name as an intrinsic in both cases.
-
-After verifying that the program unit making implicit use
-of the intrinsic is indeed written expecting the intrinsic,
-add an @samp{INTRINSIC @var{intrinsic}} statement to that
-program unit to prevent this warning.
-
-This and related warnings are disabled by using
-the @option{-Wno-globals} option when compiling.
-
-Note that this warning is not issued for standard intrinsics.
-Standard intrinsics include those described in the FORTRAN 77
-standard and, if @option{-ff90} is specified, those described
-in the Fortran 90 standard.
-Such intrinsics are not as likely to be confused with user
-procedures as intrinsics provided as extensions to the
-standard by @command{g77}.
-
-@node INTGLOB
-@section @code{INTGLOB}
-
-@noindent
-@smallexample
-Same name `@var{intrinsic}' given @dots{}
-@end smallexample
-
-The name @var{intrinsic} is used for a global entity (a common
-block or a program unit) in one program unit and implicitly
-used as an intrinsic in another program unit.
-
-This diagnostic is designed to catch cases where a program
-intends to use a name entirely as a global name, but @command{g77}
-recognizes the name as an intrinsic in the program unit that
-references the name, a situation that would likely produce
-incorrect code.
-
-For example:
-
-@smallexample
-INTEGER FUNCTION TIME()
-@dots{}
-END
-@dots{}
-PROGRAM SAMP
-INTEGER TIME
-PRINT *, 'Time is ', TIME()
-END
-@end smallexample
-
-The above example defines a program unit named @samp{TIME}, but
-the reference to @samp{TIME} in the main program unit @samp{SAMP}
-is normally treated by @command{g77} as a reference to the intrinsic
-@code{TIME()} (unless a command-line option that prevents such
-treatment has been specified).
-
-As a result, the program @samp{SAMP} will @emph{not}
-invoke the @samp{TIME} function in the same source file.
-
-Since @command{g77} recognizes @code{libU77} procedures as
-intrinsics, and since some existing code uses the same names
-for its own procedures as used by some @code{libU77}
-procedures, this situation is expected to arise often enough
-to make this sort of warning worth issuing.
-
-After verifying that the program unit making implicit use
-of the intrinsic is indeed written expecting the intrinsic,
-add an @samp{INTRINSIC @var{intrinsic}} statement to that
-program unit to prevent this warning.
-
-Or, if you believe the program unit is designed to invoke the
-program-defined procedure instead of the intrinsic (as
-recognized by @command{g77}), add an @samp{EXTERNAL @var{intrinsic}}
-statement to the program unit that references the name to
-prevent this warning.
-
-This and related warnings are disabled by using
-the @option{-Wno-globals} option when compiling.
-
-Note that this warning is not issued for standard intrinsics.
-Standard intrinsics include those described in the FORTRAN 77
-standard and, if @option{-ff90} is specified, those described
-in the Fortran 90 standard.
-Such intrinsics are not as likely to be confused with user
-procedures as intrinsics provided as extensions to the
-standard by @command{g77}.
-
-@node LEX
-@section @code{LEX}
-
-@noindent
-@smallexample
-Unrecognized character @dots{}
-Invalid first character @dots{}
-Line too long @dots{}
-Non-numeric character @dots{}
-Continuation indicator @dots{}
-Label at @dots{} invalid with continuation line indicator @dots{}
-Character constant @dots{}
-Continuation line @dots{}
-Statement at @dots{} begins with invalid token
-@end smallexample
-
-Although the diagnostics identify specific problems, they can
-be produced when general problems such as the following occur:
-
-@itemize @bullet
-@item
-The source file contains something other than Fortran code.
-
-If the code in the file does not look like many of the examples
-elsewhere in this document, it might not be Fortran code.
-(Note that Fortran code often is written in lower case letters,
-while the examples in this document use upper case letters,
-for stylistic reasons.)
-
-For example, if the file contains lots of strange-looking
-characters, it might be APL source code; if it contains lots
-of parentheses, it might be Lisp source code; if it
-contains lots of bugs, it might be C++ source code.
-
-@item
-The source file contains free-form Fortran code, but @option{-ffree-form}
-was not specified on the command line to compile it.
-
-Free form is a newer form for Fortran code.
-The older, classic form is called fixed form.
-
-@cindex continuation character
-@cindex characters, continuation
-Fixed-form code is visually fairly distinctive, because
-numerical labels and comments are all that appear in
-the first five columns of a line, the sixth column is
-reserved to denote continuation lines,
-and actual statements start at or beyond column 7.
-Spaces generally are not significant, so if you
-see statements such as @samp{REALX,Y} and @samp{DO10I=1,100},
-you are looking at fixed-form code.
-@cindex *
-@cindex asterisk
-Comment lines are indicated by the letter @samp{C} or the symbol
-@samp{*} in column 1.
-@cindex trailing comment
-@cindex comment
-@cindex characters, comment
-@cindex !
-@cindex exclamation point
-(Some code uses @samp{!} or @samp{/*} to begin in-line comments,
-which many compilers support.)
-
-Free-form code is distinguished from fixed-form source
-primarily by the fact that statements may start anywhere.
-(If lots of statements start in columns 1 through 6,
-that's a strong indicator of free-form source.)
-Consecutive keywords must be separated by spaces, so
-@samp{REALX,Y} is not valid, while @samp{REAL X,Y} is.
-There are no comment lines per se, but @samp{!} starts a
-comment anywhere in a line (other than within a character or
-Hollerith constant).
-
-@xref{Source Form}, for more information.
-
-@item
-The source file is in fixed form and has been edited without
-sensitivity to the column requirements.
-
-Statements in fixed-form code must be entirely contained within
-columns 7 through 72 on a given line.
-Starting them ``early'' is more likely to result in diagnostics
-than finishing them ``late'', though both kinds of errors are
-often caught at compile time.
-
-For example, if the following code fragment is edited by following
-the commented instructions literally, the result, shown afterward,
-would produce a diagnostic when compiled:
-
-@smallexample
-C On XYZZY systems, remove "C" on next line:
-C     CALL XYZZY_RESET
-@end smallexample
-
-The result of editing the above line might be:
-
-@smallexample
-C On XYZZY systems, remove "C" on next line:
-     CALL XYZZY_RESET
-@end smallexample
-
-However, that leaves the first @samp{C} in the @code{CALL}
-statement in column 6, making it a comment line, which is
-not really what the author intended, and which is likely
-to result in one of the above-listed diagnostics.
-
-@emph{Replacing} the @samp{C} in column 1 with a space
-is the proper change to make, to ensure the @code{CALL}
-keyword starts in or after column 7.
-
-Another common mistake like this is to forget that fixed-form
-source lines are significant through only column 72, and that,
-normally, any text beyond column 72 is ignored or is diagnosed
-at compile time.
-
-@xref{Source Form}, for more information.
-
-@item
-The source file requires preprocessing, and the preprocessing
-is not being specified at compile time.
-
-A source file containing lines beginning with @code{#define},
-@code{#include}, @code{#if}, and so on is likely one that
-requires preprocessing.
-
-If the file's suffix is @samp{.f}, @samp{.for}, or @samp{.FOR},
-the file normally will be compiled @emph{without} preprocessing
-by @command{g77}.
-
-Change the file's suffix from @samp{.f} to @samp{.F}
-(or, on systems with case-insensitive file names,
-to @samp{.fpp} or @samp{.FPP}),
-from @samp{.for} to @samp{.fpp},
-or from @samp{.FOR} to @samp{.FPP}.
-@command{g77} compiles files with such names @emph{with}
-preprocessing.
-
-@pindex cpp
-@cindex preprocessor
-@cindex cpp program
-@cindex programs, cpp
-@cindex @option{-x f77-cpp-input} option
-@cindex options, @option{-x f77-cpp-input}
-Or, learn how to use @command{gcc}'s @option{-x} option to specify
-the language @samp{f77-cpp-input} for Fortran files that
-require preprocessing.
-@xref{Overall Options,,Options Controlling the Kind of
-Output,gcc,Using the GNU Compiler Collection (GCC)}.
-
-@item
-The source file is preprocessed, and the results of preprocessing
-result in syntactic errors that are not necessarily obvious to
-someone examining the source file itself.
-
-Examples of errors resulting from preprocessor macro expansion
-include exceeding the line-length limit, improperly starting,
-terminating, or incorporating the apostrophe or double-quote in
-a character constant, improperly forming a Hollerith constant,
-and so on.
-
-@xref{Overall Options,,Options Controlling the Kind of Output},
-for suggestions about how to use, and not use, preprocessing
-for Fortran code.
-@end itemize
-
-@node GLOBALS
-@section @code{GLOBALS}
-
-@noindent
-@smallexample
-Global name @var{name} defined at @dots{} already defined@dots{}
-Global name @var{name} at @dots{} has different type@dots{}
-Too many arguments passed to @var{name} at @dots{}
-Too few arguments passed to @var{name} at @dots{}
-Argument #@var{n} of @var{name} is @dots{}
-@end smallexample
-
-These messages all identify disagreements about the
-global procedure named @var{name} among different program units
-(usually including @var{name} itself).
-
-Whether a particular disagreement is reported
-as a warning or an error
-can depend on the relative order
-of the disagreeing portions of the source file.
-
-Disagreements between a procedure invocation
-and the @emph{subsequent} procedure itself
-are, usually, diagnosed as errors
-when the procedure itself @emph{precedes} the invocation.
-Other disagreements are diagnosed via warnings.
-
-@cindex forward references
-@cindex in-line code
-@cindex compilation, in-line
-This distinction, between warnings and errors,
-is due primarily to the present tendency of the @command{gcc} back end
-to inline only those procedure invocations that are
-@emph{preceded} by the corresponding procedure definitions.
-If the @command{gcc} back end is changed
-to inline ``forward references'',
-in which invocations precede definitions,
-the @command{g77} front end will be changed
-to treat both orderings as errors, accordingly.
-
-The sorts of disagreements that are diagnosed by @command{g77} include
-whether a procedure is a subroutine or function;
-if it is a function, the type of the return value of the procedure;
-the number of arguments the procedure accepts;
-and the type of each argument.
-
-Disagreements regarding global names among program units
-in a Fortran program @emph{should} be fixed in the code itself.
-However, if that is not immediately practical,
-and the code has been working for some time,
-it is possible it will work
-when compiled with the @option{-fno-globals} option.
-
-The @option{-fno-globals} option
-causes these diagnostics to all be warnings
-and disables all inlining of references to global procedures
-(to avoid subsequent compiler crashes and bad-code generation).
-Use of the @option{-Wno-globals} option as well as @option{-fno-globals}
-suppresses all of these diagnostics.
-(@option{-Wno-globals} by itself disables only the warnings,
-not the errors.)
-
-After using @option{-fno-globals} to work around these problems,
-it is wise to stop using that option and address them by fixing
-the Fortran code, because such problems, while they might not
-actually result in bugs on some systems, indicate that the code
-is not as portable as it could be.
-In particular, the code might appear to work on a particular
-system, but have bugs that affect the reliability of the data
-without exhibiting any other outward manifestations of the bugs.
-
-@node LINKFAIL
-@section @code{LINKFAIL}
-
-@noindent
-On AIX 4.1, @command{g77} might not build with the native (non-GNU) tools
-due to a linker bug in coping with the @option{-bbigtoc} option which
-leads to a @samp{Relocation overflow} error.  The GNU linker is not
-recommended on current AIX versions, though; it was developed under a
-now-unsupported version.  This bug is said to be fixed by `update PTF
-U455193 for APAR IX75823'.
-
-Compiling with @option{-mminimal-toc}
-might solve this problem, e.g.@: by adding
-@smallexample
-BOOT_CFLAGS='-mminimal-toc -O2 -g'
-@end smallexample
-to the @code{make bootstrap} command line.
-
-@node Y2KBAD
-@section @code{Y2KBAD}
-@cindex Y2K compliance
-@cindex Year 2000 compliance
-
-@noindent
-@smallexample
-Intrinsic `@var{name}', invoked at (^), known to be non-Y2K-compliant@dots{}
-@end smallexample
-
-This diagnostic indicates that
-the specific intrinsic invoked by the name @var{name}
-is known to have an interface
-that is not Year-2000 (Y2K) compliant.
-
-@xref{Year 2000 (Y2K) Problems}.
-
-@end ifset
-
-@node Keyword Index
-@unnumbered Keyword Index
-
-@printindex cp
-@bye
diff --git a/gcc/f/g77spec.c b/gcc/f/g77spec.c
deleted file mode 100644
index 3dca7bc..0000000
--- a/gcc/f/g77spec.c
+++ /dev/null
@@ -1,541 +0,0 @@
-/* Specific flags and argument handling of the Fortran front-end.
-   Copyright (C) 1997, 1999, 2000, 2001, 2002, 2003, 2004
-   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.  */
-
-/* This file contains a filter for the main `gcc' driver, which is
-   replicated for the `g77' driver by adding this filter.  The purpose
-   of this filter is to be basically identical to gcc (in that
-   it faithfully passes all of the original arguments to gcc) but,
-   unless explicitly overridden by the user in certain ways, ensure
-   that the needs of the language supported by this wrapper are met.
-
-   For GNU Fortran (g77), we do the following to the argument list
-   before passing it to `gcc':
-
-   1.  Make sure `-lg2c -lm' is at the end of the list.
-
-   2.  Make sure each time `-lg2c' or `-lm' is seen, it forms
-       part of the series `-lg2c -lm'.
-
-   #1 and #2 are not done if `-nostdlib' or any option that disables
-   the linking phase is present, or if `-xfoo' is in effect.  Note that
-   a lack of source files or -l options disables linking.
-
-   This program was originally made out of gcc/cp/g++spec.c, but the
-   way it builds the new argument list was rewritten so it is much
-   easier to maintain, improve the way it decides to add or not add
-   extra arguments, etc.  And several improvements were made in the
-   handling of arguments, primarily to make it more consistent with
-   `gcc' itself.  */
-
-#include "config.h"
-#include "system.h"
-#include "coretypes.h"
-#include "tm.h"
-#include "gcc.h"
-#include "intl.h"
-
-#ifndef MATH_LIBRARY
-#define MATH_LIBRARY "-lm"
-#endif
-
-#ifndef FORTRAN_INIT
-#define FORTRAN_INIT "-lfrtbegin"
-#endif
-
-#ifndef FORTRAN_LIBRARY
-#define FORTRAN_LIBRARY "-lg2c"
-#endif
-
-/* Options this driver needs to recognize, not just know how to
-   skip over.  */
-typedef enum
-{
-  OPTION_b,			/* Aka --prefix. */
-  OPTION_B,			/* Aka --target. */
-  OPTION_c,			/* Aka --compile. */
-  OPTION_driver,		/* Wrapper-specific option. */
-  OPTION_E,			/* Aka --preprocess. */
-  OPTION_help,			/* --help. */
-  OPTION_i,			/* -imacros, -include, -include-*. */
-  OPTION_l,
-  OPTION_L,			/* Aka --library-directory. */
-  OPTION_M,			/* Aka --dependencies. */
-  OPTION_MM,			/* Aka --user-dependencies. */
-  OPTION_nostdlib,		/* Aka --no-standard-libraries, or
-				   -nodefaultlibs. */
-  OPTION_o,			/* Aka --output. */
-  OPTION_S,			/* Aka --assemble. */
-  OPTION_syntax_only,		/* -fsyntax-only. */
-  OPTION_v,			/* Aka --verbose. */
-  OPTION_version,		/* --version. */
-  OPTION_V,			/* Aka --use-version. */
-  OPTION_x,			/* Aka --language. */
-  OPTION_			/* Unrecognized or unimportant. */
-} Option;
-
-/* The original argument list and related info is copied here.  */
-static int g77_xargc;
-static const char *const *g77_xargv;
-static void lookup_option (Option *, int *, const char **, const char *);
-static void append_arg (const char *);
-
-/* The new argument list will be built here.  */
-static int g77_newargc;
-static const char **g77_newargv;
-
-#ifndef SWITCH_TAKES_ARG
-#define SWITCH_TAKES_ARG(CHAR) DEFAULT_SWITCH_TAKES_ARG(CHAR)
-#endif
-
-#ifndef WORD_SWITCH_TAKES_ARG
-#define WORD_SWITCH_TAKES_ARG(STR) DEFAULT_WORD_SWITCH_TAKES_ARG (STR)
-#endif
-
-/* Assumes text[0] == '-'.  Returns number of argv items that belong to
-   (and follow) this one, an option id for options important to the
-   caller, and a pointer to the first char of the arg, if embedded (else
-   returns NULL, meaning no arg or it's the next argv).
-
-   Note that this also assumes gcc.c's pass converting long options
-   to short ones, where available, has already been run.  */
-
-static void
-lookup_option (Option *xopt, int *xskip, const char **xarg, const char *text)
-{
-  Option opt = OPTION_;
-  int skip;
-  const char *arg = NULL;
-
-  if ((skip = SWITCH_TAKES_ARG (text[1])))
-    skip -= (text[2] != '\0');	/* See gcc.c. */
-
-  if (text[1] == 'B')
-    opt = OPTION_B, skip = (text[2] == '\0'), arg = text + 2;
-  else if (text[1] == 'b')
-    opt = OPTION_b, skip = (text[2] == '\0'), arg = text + 2;
-  else if ((text[1] == 'c') && (text[2] == '\0'))
-    opt = OPTION_c, skip = 0;
-  else if ((text[1] == 'E') && (text[2] == '\0'))
-    opt = OPTION_E, skip = 0;
-  else if (text[1] == 'i')
-    opt = OPTION_i, skip = 0;
-  else if (text[1] == 'l')
-    opt = OPTION_l;
-  else if (text[1] == 'L')
-    opt = OPTION_L, arg = text + 2;
-  else if (text[1] == 'o')
-    opt = OPTION_o;
-  else if ((text[1] == 'S') && (text[2] == '\0'))
-    opt = OPTION_S, skip = 0;
-  else if (text[1] == 'V')
-    opt = OPTION_V, skip = (text[2] == '\0');
-  else if ((text[1] == 'v') && (text[2] == '\0'))
-    opt = OPTION_v, skip = 0;
-  else if (text[1] == 'x')
-    opt = OPTION_x, arg = text + 2;
-  else
-    {
-      if ((skip = WORD_SWITCH_TAKES_ARG (text + 1)) != 0)  /* See gcc.c. */
-	;
-      else if (! strncmp (text, "-fdriver", 8))  /* Really --driver!! */
-	opt = OPTION_driver;	/* Never mind arg, this is unsupported. */
-      else if (! strcmp (text, "-fhelp"))  /* Really --help!! */
-	opt = OPTION_help;
-      else if (! strcmp (text, "-M"))
-	opt = OPTION_M;
-      else if (! strcmp (text, "-MM"))
-	opt = OPTION_MM;
-      else if (! strcmp (text, "-nostdlib")
-	       || ! strcmp (text, "-nodefaultlibs"))
-	opt = OPTION_nostdlib;
-      else if (! strcmp (text, "-fsyntax-only"))
-	opt = OPTION_syntax_only;
-      else if (! strcmp (text, "-dumpversion"))
-	opt = OPTION_version;
-      else if (! strcmp (text, "-fversion"))  /* Really --version!! */
-	opt = OPTION_version;
-      else if (! strcmp (text, "-Xlinker")
-	       || ! strcmp (text, "-specs"))
-	skip = 1;
-      else
-	skip = 0;
-    }
-
-  if (xopt != NULL)
-    *xopt = opt;
-  if (xskip != NULL)
-    *xskip = skip;
-  if (xarg != NULL)
-    {
-      if ((arg != NULL)
-	  && (arg[0] == '\0'))
-	*xarg = NULL;
-      else
-	*xarg = arg;
-    }
-}
-
-/* Append another argument to the list being built.  As long as it is
-   identical to the corresponding arg in the original list, just increment
-   the new arg count.  Otherwise allocate a new list, etc.  */
-
-static void
-append_arg (const char *arg)
-{
-  static int newargsize;
-
-#if 0
-  fprintf (stderr, "`%s'\n", arg);
-#endif
-
-  if (g77_newargv == g77_xargv
-      && g77_newargc < g77_xargc
-      && (arg == g77_xargv[g77_newargc]
-	  || ! strcmp (arg, g77_xargv[g77_newargc])))
-    {
-      ++g77_newargc;
-      return;			/* Nothing new here. */
-    }
-
-  if (g77_newargv == g77_xargv)
-    {				/* Make new arglist. */
-      int i;
-
-      newargsize = (g77_xargc << 2) + 20;	/* This should handle all. */
-      g77_newargv = xmalloc (newargsize * sizeof (char *));
-
-      /* Copy what has been done so far.  */
-      for (i = 0; i < g77_newargc; ++i)
-	g77_newargv[i] = g77_xargv[i];
-    }
-
-  if (g77_newargc == newargsize)
-    fatal ("overflowed output arg list for `%s'", arg);
-
-  g77_newargv[g77_newargc++] = arg;
-}
-
-void
-lang_specific_driver (int *in_argc, const char *const **in_argv,
-		      int *in_added_libraries ATTRIBUTE_UNUSED)
-{
-  int argc = *in_argc;
-  const char *const *argv = *in_argv;
-  int i;
-  int verbose = 0;
-  Option opt;
-  int skip;
-  const char *arg;
-
-  /* This will be NULL if we encounter a situation where we should not
-     link in libf2c.  */
-  const char *library = FORTRAN_LIBRARY;
-
-  /* 0 => -xnone in effect.
-     1 => -xfoo in effect.  */
-  int saw_speclang = 0;
-
-  /* 0 => initial/reset state
-     1 => last arg was -l<library>
-     2 => last two args were -l<library> -lm.  */
-  int saw_library = 0;
-
-  /* 0 => initial/reset state
-     1 => FORTRAN_INIT linked in */
-  int use_init = 0;
-  /* By default, we throw on the math library if we have one.  */
-  int need_math = (MATH_LIBRARY[0] != '\0');
-
-  /* The number of input and output files in the incoming arg list.  */
-  int n_infiles = 0;
-  int n_outfiles = 0;
-
-#if 0
-  fprintf (stderr, "Incoming:");
-  for (i = 0; i < argc; i++)
-    fprintf (stderr, " %s", argv[i]);
-  fprintf (stderr, "\n");
-#endif
-
-  g77_xargc = argc;
-  g77_xargv = argv;
-  g77_newargc = 0;
-  g77_newargv = (const char **) argv;
-
-  /* First pass through arglist.
-
-     If -nostdlib or a "turn-off-linking" option is anywhere in the
-     command line, don't do any library-option processing (except
-     relating to -x).  Also, if -v is specified, but no other options
-     that do anything special (allowing -V version, etc.), remember
-     to add special stuff to make gcc command actually invoke all
-     the different phases of the compilation process so all the version
-     numbers can be seen.
-
-     Also, here is where all problems with missing arguments to options
-     are caught.  If this loop is exited normally, it means all options
-     have the appropriate number of arguments as far as the rest of this
-     program is concerned.  */
-
-  for (i = 1; i < argc; ++i)
-    {
-      if ((argv[i][0] == '+') && (argv[i][1] == 'e'))
-	{
-	  continue;
-	}
-
-      if ((argv[i][0] != '-') || (argv[i][1] == '\0'))
-	{
-	  ++n_infiles;
-	  continue;
-	}
-
-      lookup_option (&opt, &skip, NULL, argv[i]);
-
-      switch (opt)
-	{
-	case OPTION_nostdlib:
-	case OPTION_c:
-	case OPTION_S:
-	case OPTION_syntax_only:
-	case OPTION_E:
-	case OPTION_M:
-	case OPTION_MM:
-	  /* These options disable linking entirely or linking of the
-	     standard libraries.  */
-	  library = 0;
-	  break;
-
-	case OPTION_l:
-	  ++n_infiles;
-	  break;
-
-	case OPTION_o:
-	  ++n_outfiles;
-	  break;
-
-	case OPTION_v:
-	  verbose = 1;
-	  break;
-
-	case OPTION_b:
-	case OPTION_B:
-	case OPTION_L:
-	case OPTION_i:
-	case OPTION_V:
-	  /* These options are useful in conjunction with -v to get
-	     appropriate version info.  */
-	  break;
-
-	case OPTION_version:
-	  printf ("GNU Fortran (GCC) %s\n", version_string);
-	  printf ("Copyright %s 2004 Free Software Foundation, Inc.\n",
-		  _("(C)"));
-	  printf ("\n");
-	  printf (_("\
-GNU Fortran comes with NO WARRANTY, to the extent permitted by law.\n\
-You may redistribute copies of GNU Fortran\n\
-under the terms of the GNU General Public License.\n\
-For more information about these matters, see the file named COPYING\n\
-or type the command `info -f g77 Copying'.\n\
-"));
-	  exit (0);
-	  break;
-
-	case OPTION_help:
-	  /* Let gcc.c handle this, as it has a really
-	     cool facility for handling --help and --verbose --help.  */
-	  return;
-
-	case OPTION_driver:
-	  fatal ("--driver no longer supported");
-	  break;
-
-	default:
-	  break;
-	}
-
-      /* This is the one place we check for missing arguments in the
-	 program.  */
-
-      if (i + skip < argc)
-	i += skip;
-      else
-	fatal ("argument to `%s' missing", argv[i]);
-    }
-
-  if ((n_outfiles != 0) && (n_infiles == 0))
-    fatal ("no input files; unwilling to write output files");
-
-  /* If there are no input files, no need for the library.  */
-  if (n_infiles == 0)
-    library = 0;
-
-  /* Second pass through arglist, transforming arguments as appropriate.  */
-
-  append_arg (argv[0]);	/* Start with command name, of course. */
-
-  for (i = 1; i < argc; ++i)
-    {
-      if (argv[i][0] == '\0')
-	{
-	  append_arg (argv[i]);	/* Interesting.  Just append as is. */
-	  continue;
-	}
-
-      if ((argv[i][0] == '-') && (argv[i][1] != 'l'))
-	{
-	  /* Not a filename or library. */
-
-	 if (saw_library == 1 && need_math)    /* -l<library>. */
-	    append_arg (MATH_LIBRARY);
-
-	  saw_library = 0;
-
-	  lookup_option (&opt, &skip, &arg, argv[i]);
-
-	  if (argv[i][1] == '\0')
-	    {
-	      append_arg (argv[i]);	/* "-" == Standard input. */
-	      continue;
-	    }
-
-	  if (opt == OPTION_x)
-	    {
-	      /* Track input language. */
-	      const char *lang;
-
-	      if (arg == NULL)
-		lang = argv[i+1];
-	      else
-		lang = arg;
-
-	      saw_speclang = (strcmp (lang, "none") != 0);
-	    }
-
-	  append_arg (argv[i]);
-
-	  for (; skip != 0; --skip)
-	    append_arg (argv[++i]);
-
-	  continue;
-	}
-
-      /* A filename/library, not an option. */
-
-      if (saw_speclang)
-	saw_library = 0;	/* -xfoo currently active. */
-      else
-	{			/* -lfoo or filename. */
-	  if (strcmp (argv[i], MATH_LIBRARY) == 0)
-	    {
-	      if (saw_library == 1)
-		saw_library = 2;	/* -l<library> -lm. */
-	      else
-		{
-		  if (0 == use_init)
-		    {
-		      append_arg (FORTRAN_INIT);
-		      use_init = 1;
-		    }
-		  append_arg (FORTRAN_LIBRARY);
-		}
-	    }
-	  else if (strcmp (argv[i], FORTRAN_LIBRARY) == 0)
-	    saw_library = 1;	/* -l<library>. */
-	  else
-	    {		/* Other library, or filename. */
-	     if (saw_library == 1 && need_math)
-		append_arg (MATH_LIBRARY);
-	      saw_library = 0;
-	    }
-	}
-      append_arg (argv[i]);
-    }
-
-  /* Append `-lg2c -lm' as necessary.  */
-
-  if (library)
-    {				/* Doing a link and no -nostdlib. */
-      if (saw_speclang)
-	append_arg ("-xnone");
-
-      switch (saw_library)
-	{
-	case 0:
-	  if (0 == use_init)
-	    {
-	      append_arg (FORTRAN_INIT);
-	      use_init = 1;
-	    }
-	  append_arg (library);
-	case 1:
-	 if (need_math)
-	   append_arg (MATH_LIBRARY);
-	default:
-	  break;
-	}
-    }
-
-#ifdef ENABLE_SHARED_LIBGCC
-  if (library)
-    {
-      int i;
-
-      for (i = 1; i < g77_newargc; i++)
-	if (g77_newargv[i][0] == '-')
-	  if (strcmp (g77_newargv[i], "-static-libgcc") == 0
-	      || strcmp (g77_newargv[i], "-static") == 0)
-	    break;
-    
-      if (i == g77_newargc)
-	append_arg ("-shared-libgcc");
-    }
-  
-#endif
-
-  if (verbose
-      && g77_newargv != g77_xargv)
-    {
-      fprintf (stderr, "Driving:");
-      for (i = 0; i < g77_newargc; i++)
-	fprintf (stderr, " %s", g77_newargv[i]);
-      fprintf (stderr, "\n");
-    }
-
-  *in_argc = g77_newargc;
-  *in_argv = g77_newargv;
-}
-
-/* Called before linking.  Returns 0 on success and -1 on failure. */
-int lang_specific_pre_link (void)  /* Not used for F77. */
-{
-  return 0;
-}
-
-/* Number of extra output files that lang_specific_pre_link may generate. */
-int lang_specific_extra_outfiles = 0;  /* Not used for F77. */
-
-/* Table of language-specific spec functions.  */ 
-const struct spec_function lang_specific_spec_functions[] =
-{
-  { 0, 0 }
-};
diff --git a/gcc/f/global.c b/gcc/f/global.c
deleted file mode 100644
index 8793f62..0000000
--- a/gcc/f/global.c
+++ /dev/null
@@ -1,1586 +0,0 @@
-/* global.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-
-   Description:
-      Manages information kept across individual program units within a single
-      source file.  This includes reporting errors when a name is defined
-      multiple times (for example, two program units named FOO) and when a
-      COMMON block is given initial data in more than one program unit.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "global.h"
-#include "info.h"
-#include "lex.h"
-#include "malloc.h"
-#include "name.h"
-#include "symbol.h"
-#include "top.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-#if FFEGLOBAL_ENABLED
-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?"
-};
-#endif
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* Call given fn with all globals
-
-   ffeglobal (*fn)(ffeglobal g);
-   ffeglobal_drive(fn);	 */
-
-#if FFEGLOBAL_ENABLED
-void
-ffeglobal_drive (ffeglobal (*fn) (ffeglobal))
-{
-  if (ffeglobal_filewide_ != NULL)
-    ffename_space_drive_global (ffeglobal_filewide_, fn);
-}
-
-#endif
-/* ffeglobal_new_ -- Make new global
-
-   ffename n;
-   ffeglobal g;
-   g = ffeglobal_new_(n);  */
-
-#if FFEGLOBAL_ENABLED
-static ffeglobal
-ffeglobal_new_ (ffename n)
-{
-  ffeglobal g;
-
-  assert (n != NULL);
-
-  g = malloc_new_ks (malloc_pool_image (), "FFEGLOBAL", sizeof (*g));
-  g->n = n;
-  g->hook = FFECOM_globalNULL;
-  g->tick = 0;
-
-  ffename_set_global (n, g);
-
-  return g;
-}
-
-#endif
-/* ffeglobal_init_1 -- Initialize per file
-
-   ffeglobal_init_1();	*/
-
-void
-ffeglobal_init_1 (void)
-{
-#if FFEGLOBAL_ENABLED
-  if (ffeglobal_filewide_ != NULL)
-    ffename_space_kill (ffeglobal_filewide_);
-  ffeglobal_filewide_ = ffename_space_new (malloc_pool_image ());
-#endif
-}
-
-/* ffeglobal_init_common -- Initial value specified for common block
-
-   ffesymbol s;	 // the ffesymbol for the common block
-   ffelexToken t;  // the token with the point of initialization
-   ffeglobal_init_common(s,t);
-
-   For back ends where file-wide global symbols are not maintained, does
-   nothing.  Otherwise, makes sure this common block hasn't already been
-   initialized in a previous program unit, and flag that it's been
-   initialized in this one.  */
-
-void
-ffeglobal_init_common (ffesymbol s, ffelexToken t)
-{
-#if FFEGLOBAL_ENABLED
-  ffeglobal g;
-
-  g = ffesymbol_global (s);
-
-  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
-    return;
-  if (g->type == FFEGLOBAL_typeANY)
-    return;
-
-  if (g->tick == ffe_count_2)
-    return;
-
-  if (g->tick != 0)
-    {
-      if (g->u.common.initt != NULL)
-	{
-	  ffebad_start (FFEBAD_COMMON_ALREADY_INIT);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->u.common.initt),
-		       ffelex_token_where_column (g->u.common.initt));
-	  ffebad_finish ();
-	}
-
-      /* Complain about just one attempt to reinit per program unit, but
-	 continue referring back to the first such successful attempt.  */
-    }
-  else
-    {
-      if (g->u.common.blank)
-	{
-	  /* Not supposed to initialize blank common, though it works.  */
-	  ffebad_start (FFEBAD_COMMON_BLANK_INIT);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-
-      g->u.common.initt = ffelex_token_use (t);
-    }
-
-  g->tick = ffe_count_2;
-#endif
-}
-
-/* ffeglobal_new_common -- New common block
-
-   ffesymbol s;	 // the ffesymbol for the new common block
-   ffelexToken t;  // the token with the name of the common block
-   bool blank;	// TRUE if blank common
-   ffeglobal_new_common(s,t,blank);
-
-   For back ends where file-wide global symbols are not maintained, does
-   nothing.  Otherwise, makes sure this symbol hasn't been seen before or
-   is known as a common block.	*/
-
-void
-ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank)
-{
-#if FFEGLOBAL_ENABLED
-  ffename n;
-  ffeglobal g;
-
-  if (ffesymbol_global (s) == NULL)
-    {
-      n = ffename_find (ffeglobal_filewide_, t);
-      g = ffename_global (n);
-    }
-  else
-    {
-      g = ffesymbol_global (s);
-      n = NULL;
-    }
-
-  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
-    return;
-
-  if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
-    {
-      if (g->type == FFEGLOBAL_typeCOMMON)
-	{
-	  /* The names match, so the "blankness" should match too!  */
-	  assert (g->u.common.blank == blank);
-	}
-      else
-	{
-	  /* This global name has already been established,
-	     but as something other than a common block.  */
-	  if (ffe_is_globals () || ffe_is_warn_globals ())
-	    {
-	      ffebad_start (ffe_is_globals ()
-			    ? FFEBAD_FILEWIDE_ALREADY_SEEN
-			    : FFEBAD_FILEWIDE_ALREADY_SEEN_W);
-	      ffebad_string (ffelex_token_text (t));
-	      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	      ffebad_here (1, ffelex_token_where_line (g->t),
-			   ffelex_token_where_column (g->t));
-	      ffebad_finish ();
-	    }
-	  g->type = FFEGLOBAL_typeANY;
-	}
-    }
-  else
-    {
-      if (g == NULL)
-	{
-	  g = ffeglobal_new_ (n);
-	  g->intrinsic = FALSE;
-	}
-      else if (g->intrinsic
-	       && !g->explicit_intrinsic
-	       && ffe_is_warn_globals ())
-	{
-	  /* Common name previously used as intrinsic.  Though it works,
-	     warn, because the intrinsic reference might have been intended
-	     as a ref to an external procedure, but g77's vast list of
-	     intrinsics happened to snarf the name.  */
-	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_string ("common block");
-	  ffebad_string ("intrinsic");
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-      g->t = ffelex_token_use (t);
-      g->type = FFEGLOBAL_typeCOMMON;
-      g->u.common.have_pad = FALSE;
-      g->u.common.have_save = FALSE;
-      g->u.common.have_size = FALSE;
-      g->u.common.blank = blank;
-    }
-
-  ffesymbol_set_global (s, g);
-#endif
-}
-
-/* ffeglobal_new_progunit_ -- New program unit
-
-   ffesymbol s;	 // the ffesymbol for the new unit
-   ffelexToken t;  // the token with the name of the unit
-   ffeglobalType type;	// the type of the new unit
-   ffeglobal_new_progunit_(s,t,type);
-
-   For back ends where file-wide global symbols are not maintained, does
-   nothing.  Otherwise, makes sure this symbol hasn't been seen before.	 */
-
-void
-ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
-{
-#if FFEGLOBAL_ENABLED
-  ffename n;
-  ffeglobal g;
-
-  n = ffename_find (ffeglobal_filewide_, t);
-  g = ffename_global (n);
-  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
-    return;
-
-  if ((g != NULL)
-      && ((g->type == FFEGLOBAL_typeMAIN)
-	  || (g->type == FFEGLOBAL_typeSUBR)
-	  || (g->type == FFEGLOBAL_typeFUNC)
-	  || (g->type == FFEGLOBAL_typeBDATA))
-      && g->u.proc.defined)
-    {
-      /* This program unit has already been defined.  */
-      if (ffe_is_globals () || ffe_is_warn_globals ())
-	{
-	  ffebad_start (ffe_is_globals ()
-			? FFEBAD_FILEWIDE_ALREADY_SEEN
-			: FFEBAD_FILEWIDE_ALREADY_SEEN_W);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-      g->type = FFEGLOBAL_typeANY;
-    }
-  else if ((g != NULL)
-	   && (g->type != FFEGLOBAL_typeNONE)
-	   && (g->type != FFEGLOBAL_typeEXT)
-	   && (g->type != type))
-    {
-      /* A reference to this program unit has been seen, but its
-	 context disagrees about the new definition regarding
-	 what kind of program unit it is.  (E.g. `call foo' followed
-	 by `function foo'.)  But `external foo' alone doesn't mean
-	 disagreement with either a function or subroutine, though
-	 g77 normally interprets it as a request to force-load
-	 a block data program unit by that name (to cope with libs).  */
-      if (ffe_is_globals () || ffe_is_warn_globals ())
-	{
-	  ffebad_start (ffe_is_globals ()
-			? FFEBAD_FILEWIDE_DISAGREEMENT
-			: FFEBAD_FILEWIDE_DISAGREEMENT_W);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_string (ffeglobal_type_string_[type]);
-	  ffebad_string (ffeglobal_type_string_[g->type]);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-      g->type = FFEGLOBAL_typeANY;
-    }
-  else
-    {
-      if (g == NULL)
-	{
-	  g = ffeglobal_new_ (n);
-	  g->intrinsic = FALSE;
-	  g->u.proc.n_args = -1;
-	  g->u.proc.other_t = NULL;
-	}
-      else if ((ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
-	       && (g->type == FFEGLOBAL_typeFUNC)
-	       && ((ffesymbol_basictype (s) != g->u.proc.bt)
-		   || (ffesymbol_kindtype (s) != g->u.proc.kt)
-		   || ((ffesymbol_size (s) != FFETARGET_charactersizeNONE)
-		       && (ffesymbol_size (s) != g->u.proc.sz))))
-	{
-	  /* The previous reference and this new function definition
-	     disagree about the type of the function.  I (Burley) think
-	     this rarely occurs, because when this code is reached,
-	     the type info doesn't appear to be filled in yet.  */
-	  if (ffe_is_globals () || ffe_is_warn_globals ())
-	    {
-	      ffebad_start (ffe_is_globals ()
-			    ? FFEBAD_FILEWIDE_TYPE_MISMATCH
-			    : FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
-	      ffebad_string (ffelex_token_text (t));
-	      ffebad_here (0, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_here (1, ffelex_token_where_line (g->t),
-			   ffelex_token_where_column (g->t));
-	      ffebad_finish ();
-	    }
-	  g->type = FFEGLOBAL_typeANY;
-	  return;
-	}
-      if (g->intrinsic
-	  && !g->explicit_intrinsic
-	  && ffe_is_warn_globals ())
-	{
-	  /* This name, previously used as an intrinsic, now is known
-	     to also be a global procedure name.  Warn, since the previous
-	     use as an intrinsic might have been intended to refer to
-	     this procedure.  */
-	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_string ("global");
-	  ffebad_string ("intrinsic");
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-      g->t = ffelex_token_use (t);
-      if ((g->tick == 0)
-	  || (g->u.proc.bt == FFEINFO_basictypeNONE)
-	  || (g->u.proc.kt == FFEINFO_kindtypeNONE))
-	{
-	  g->u.proc.bt = ffesymbol_basictype (s);
-	  g->u.proc.kt = ffesymbol_kindtype (s);
-	  g->u.proc.sz = ffesymbol_size (s);
-	}
-      /* If there's a known disagreement about the kind of program
-	 unit, then don't even bother tracking arglist argreement.  */
-      if ((g->tick != 0)
-	  && (g->type != type))
-	g->u.proc.n_args = -1;
-      g->tick = ffe_count_2;
-      g->type = type;
-      g->u.proc.defined = TRUE;
-    }
-
-  ffesymbol_set_global (s, g);
-#endif
-}
-
-/* ffeglobal_pad_common -- Check initial padding of common area
-
-   ffesymbol s;	 // the common area
-   ffetargetAlign pad;	// the initial padding
-   ffeglobal_pad_common(s,pad,ffesymbol_where_line(s),
-	 ffesymbol_where_column(s));
-
-   In global-enabled mode, make sure the padding agrees with any existing
-   padding established for the common area, otherwise complain.
-   In global-disabled mode, warn about nonzero padding.	 */
-
-void
-ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
-		      ffewhereColumn wc)
-{
-#if FFEGLOBAL_ENABLED
-  ffeglobal g;
-
-  g = ffesymbol_global (s);
-  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
-    return;			/* Let someone else catch this! */
-  if (g->type == FFEGLOBAL_typeANY)
-    return;
-
-  if (!g->u.common.have_pad)
-    {
-      g->u.common.have_pad = TRUE;
-      g->u.common.pad = pad;
-      g->u.common.pad_where_line = ffewhere_line_use (wl);
-      g->u.common.pad_where_col = ffewhere_column_use (wc);
-
-      if (pad != 0)
-	{
-	  char padding[20];
-
-	  sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
-	  ffebad_start (FFEBAD_COMMON_INIT_PAD);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_string (padding);
-	  ffebad_string ((pad == 1)
-			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-	  ffebad_here (0, wl, wc);
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if (g->u.common.pad != pad)
-	{
-	  char padding_1[20];
-	  char padding_2[20];
-
-	  sprintf (&padding_1[0], "%" ffetargetAlign_f "u", pad);
-	  sprintf (&padding_2[0], "%" ffetargetAlign_f "u", g->u.common.pad);
-	  ffebad_start (FFEBAD_COMMON_DIFF_PAD);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_string (padding_1);
-	  ffebad_here (0, wl, wc);
-	  ffebad_string (padding_2);
-	  ffebad_string ((pad == 1)
-			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-	  ffebad_string ((g->u.common.pad == 1)
-			 ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-	  ffebad_here (1, g->u.common.pad_where_line, g->u.common.pad_where_col);
-	  ffebad_finish ();
-	}
-
-      if (g->u.common.pad < pad)
-	{
-	  g->u.common.pad = pad;
-	  g->u.common.pad_where_line = ffewhere_line_use (wl);
-	  g->u.common.pad_where_col = ffewhere_column_use (wc);
-	}
-    }
-#endif
-}
-
-/* Collect info for a global's argument.  */
-
-void
-ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as,
-			ffeinfoBasictype bt, ffeinfoKindtype kt,
-			bool array)
-{
-  ffeglobal g = ffesymbol_global (s);
-  ffeglobalArgInfo_ ai;
-
-  assert (g != NULL);
-
-  if (g->type == FFEGLOBAL_typeANY)
-    return;
-
-  assert (g->u.proc.n_args >= 0);
-
-  if (argno >= g->u.proc.n_args)
-    return;	/* Already complained about this discrepancy. */
-
-  ai = &g->u.proc.arg_info[argno];
-
-  /* Maybe warn about previous references.  */
-
-  if ((ai->t != NULL)
-      && ffe_is_warn_globals ())
-    {
-      const char *refwhy = NULL;
-      const char *defwhy = NULL;
-      bool warn = FALSE;
-
-      switch (as)
-	{
-	case FFEGLOBAL_argsummaryREF:
-	  if ((ai->as != FFEGLOBAL_argsummaryREF)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE)
-	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
-		  || (ai->bt != FFEINFO_basictypeCHARACTER)
-		  || (ai->bt == bt)))
-	    {
-	      warn = TRUE;
-	      refwhy = "passed by reference";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryDESCR:
-	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE)
-	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
-		  || (bt != FFEINFO_basictypeCHARACTER)
-		  || (ai->bt == bt)))
-	    {
-	      warn = TRUE;
-	      refwhy = "passed by descriptor";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryPROC:
-	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
-	      && (ai->as != FFEGLOBAL_argsummarySUBR)
-	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      warn = TRUE;
-	      refwhy = "a procedure";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummarySUBR:
-	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
-	      && (ai->as != FFEGLOBAL_argsummarySUBR)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      warn = TRUE;
-	      refwhy = "a subroutine";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryFUNC:
-	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
-	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      warn = TRUE;
-	      refwhy = "a function";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryALTRTN:
-	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      warn = TRUE;
-	      refwhy = "an alternate-return label";
-	    }
-	  break;
-
-	default:
-	  break;
-	}
-
-      if ((refwhy != NULL) && (defwhy == NULL))
-	{
-	  /* Fill in the def info.  */
-
-	  switch (ai->as)
-	    {
-	    case FFEGLOBAL_argsummaryNONE:
-	      defwhy = "omitted";
-	      break;
-
-	    case FFEGLOBAL_argsummaryVAL:
-	      defwhy = "passed by value";
-	      break;
-
-	    case FFEGLOBAL_argsummaryREF:
-	      defwhy = "passed by reference";
-	      break;
-
-	    case FFEGLOBAL_argsummaryDESCR:
-	      defwhy = "passed by descriptor";
-	      break;
-
-	    case FFEGLOBAL_argsummaryPROC:
-	      defwhy = "a procedure";
-	      break;
-
-	    case FFEGLOBAL_argsummarySUBR:
-	      defwhy = "a subroutine";
-	      break;
-
-	    case FFEGLOBAL_argsummaryFUNC:
-	      defwhy = "a function";
-	      break;
-
-	    case FFEGLOBAL_argsummaryALTRTN:
-	      defwhy = "an alternate-return label";
-	      break;
-
-#if 0
-	    case FFEGLOBAL_argsummaryPTR:
-	      defwhy = "a pointer";
-	      break;
-#endif
-
-	    default:
-	      defwhy = "???";
-	      break;
-	    }
-	}
-
-      if (!warn
-	  && (bt != FFEINFO_basictypeHOLLERITH)
-	  && (bt != FFEINFO_basictypeTYPELESS)
-	  && (bt != FFEINFO_basictypeNONE)
-	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
-	  && (ai->bt != FFEINFO_basictypeTYPELESS)
-	  && (ai->bt != FFEINFO_basictypeNONE))
-	{
-	  /* Check types.  */
-
-	  if ((bt != ai->bt)
-	      && ((bt != FFEINFO_basictypeREAL)
-		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
-	      && ((bt != FFEINFO_basictypeCOMPLEX)
-		  || (ai->bt != FFEINFO_basictypeREAL)))
-	    {
-	      warn = TRUE;	/* We can cope with these differences. */
-	      refwhy = "one type";
-	      defwhy = "some other type";
-	    }
-
-	  if (!warn && (kt != ai->kt))
-	    {
-	      warn = TRUE;
-	      refwhy = "one precision";
-	      defwhy = "some other precision";
-	    }
-	}
-
-      if (warn)
-	{
-	  char num[60];
-
-	  if (name == NULL)
-	    sprintf (&num[0], "%d", argno + 1);
-	  else
-	    {
-	      if (strlen (name) < 30)
-		sprintf (&num[0], "%d (named `%s')", argno + 1, name);
-	      else
-		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, name);
-	    }
-	  ffebad_start (FFEBAD_FILEWIDE_ARG_W);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_string (num);
-	  ffebad_string (refwhy);
-	  ffebad_string (defwhy);
-	  ffebad_here (0, ffelex_token_where_line (g->t), ffelex_token_where_column (g->t));
-	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
-	  ffebad_finish ();
-	}
-    }
-
-  /* Define this argument.  */
-
-  if (ai->t != NULL)
-    ffelex_token_kill (ai->t);
-  if ((as != FFEGLOBAL_argsummaryPROC)
-      || (ai->t == NULL))
-    ai->as = as;	/* Otherwise leave SUBR/FUNC info intact. */
-  ai->t = ffelex_token_use (g->t);
-  if (name == NULL)
-    ai->name = NULL;
-  else
-    {
-      ai->name = malloc_new_ks (malloc_pool_image (),
-				"ffeglobalArgInfo_ name",
-				strlen (name) + 1);
-      strcpy (ai->name, name);
-    }
-  ai->bt = bt;
-  ai->kt = kt;
-  ai->array = array;
-}
-
-/* Collect info on #args a global accepts.  */
-
-void
-ffeglobal_proc_def_nargs (ffesymbol s, int n_args)
-{
-  ffeglobal g = ffesymbol_global (s);
-
-  assert (g != NULL);
-
-  if (g->type == FFEGLOBAL_typeANY)
-    return;
-
-  if (g->u.proc.n_args >= 0)
-    {
-      if (g->u.proc.n_args == n_args)
-	return;
-
-      if (ffe_is_warn_globals ())
-	{
-	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
-	  ffebad_string (ffesymbol_text (s));
-	  if (g->u.proc.n_args > n_args)
-	    ffebad_string ("few");
-	  else
-	    ffebad_string ("many");
-	  ffebad_here (0, ffelex_token_where_line (g->u.proc.other_t),
-		       ffelex_token_where_column (g->u.proc.other_t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-    }
-
-  /* This is new info we can use in cross-checking future references
-     and a possible future definition.  */
-
-  g->u.proc.n_args = n_args;
-  g->u.proc.other_t = NULL;	/* No other reference yet. */
-
-  if (n_args == 0)
-    {
-      g->u.proc.arg_info = NULL;
-      return;
-    }
-
-  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;
-}
-
-/* Verify that the info for a global's argument is valid.  */
-
-bool
-ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
-			ffeinfoBasictype bt, ffeinfoKindtype kt,
-			bool array, ffelexToken t)
-{
-  ffeglobal g = ffesymbol_global (s);
-  ffeglobalArgInfo_ ai;
-
-  assert (g != NULL);
-
-  if (g->type == FFEGLOBAL_typeANY)
-    return FALSE;
-
-  assert (g->u.proc.n_args >= 0);
-
-  if (argno >= g->u.proc.n_args)
-    return TRUE;	/* Already complained about this discrepancy. */
-
-  ai = &g->u.proc.arg_info[argno];
-
-  /* Warn about previous references.  */
-
-  if (ai->t != NULL)
-    {
-      const char *refwhy = NULL;
-      const char *defwhy = NULL;
-      bool fail = FALSE;
-      bool warn = FALSE;
-
-      switch (as)
-	{
-	case FFEGLOBAL_argsummaryNONE:
-	  if (g->u.proc.defined)
-	    {
-	      fail = TRUE;
-	      refwhy = "omitted";
-	      defwhy = "not optional";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryVAL:
-	  if (ai->as != FFEGLOBAL_argsummaryVAL)
-	    {
-	      fail = TRUE;
-	      refwhy = "passed by value";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryREF:
-	  if ((ai->as != FFEGLOBAL_argsummaryREF)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE)
-	      && ((ai->as != FFEGLOBAL_argsummaryDESCR)	/* Choose better message. */
-		  || (ai->bt != FFEINFO_basictypeCHARACTER)
-		  || (ai->bt == bt)))
-	    {
-	      fail = TRUE;
-	      refwhy = "passed by reference";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryDESCR:
-	  if ((ai->as != FFEGLOBAL_argsummaryDESCR)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE)
-	      && ((ai->as != FFEGLOBAL_argsummaryREF)	/* Choose better message. */
-		  || (bt != FFEINFO_basictypeCHARACTER)
-		  || (ai->bt == bt)))
-	    {
-	      fail = TRUE;
-	      refwhy = "passed by descriptor";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryPROC:
-	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
-	      && (ai->as != FFEGLOBAL_argsummarySUBR)
-	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      fail = TRUE;
-	      refwhy = "a procedure";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummarySUBR:
-	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
-	      && (ai->as != FFEGLOBAL_argsummarySUBR)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      fail = TRUE;
-	      refwhy = "a subroutine";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryFUNC:
-	  if ((ai->as != FFEGLOBAL_argsummaryPROC)
-	      && (ai->as != FFEGLOBAL_argsummaryFUNC)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      fail = TRUE;
-	      refwhy = "a function";
-	    }
-	  break;
-
-	case FFEGLOBAL_argsummaryALTRTN:
-	  if ((ai->as != FFEGLOBAL_argsummaryALTRTN)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      fail = TRUE;
-	      refwhy = "an alternate-return label";
-	    }
-	  break;
-
-#if 0
-	case FFEGLOBAL_argsummaryPTR:
-	  if ((ai->as != FFEGLOBAL_argsummaryPTR)
-	      && (ai->as != FFEGLOBAL_argsummaryNONE))
-	    {
-	      fail = TRUE;
-	      refwhy = "a pointer";
-	    }
-	  break;
-#endif
-
-	default:
-	  break;
-	}
-
-      if ((refwhy != NULL) && (defwhy == NULL))
-	{
-	  /* Fill in the def info.  */
-
-	  switch (ai->as)
-	    {
-	    case FFEGLOBAL_argsummaryNONE:
-	      defwhy = "omitted";
-	      break;
-
-	    case FFEGLOBAL_argsummaryVAL:
-	      defwhy = "passed by value";
-	      break;
-
-	    case FFEGLOBAL_argsummaryREF:
-	      defwhy = "passed by reference";
-	      break;
-
-	    case FFEGLOBAL_argsummaryDESCR:
-	      defwhy = "passed by descriptor";
-	      break;
-
-	    case FFEGLOBAL_argsummaryPROC:
-	      defwhy = "a procedure";
-	      break;
-
-	    case FFEGLOBAL_argsummarySUBR:
-	      defwhy = "a subroutine";
-	      break;
-
-	    case FFEGLOBAL_argsummaryFUNC:
-	      defwhy = "a function";
-	      break;
-
-	    case FFEGLOBAL_argsummaryALTRTN:
-	      defwhy = "an alternate-return label";
-	      break;
-
-#if 0
-	    case FFEGLOBAL_argsummaryPTR:
-	      defwhy = "a pointer";
-	      break;
-#endif
-
-	    default:
-	      defwhy = "???";
-	      break;
-	    }
-	}
-
-      if (!fail && !warn
-	  && (bt != FFEINFO_basictypeHOLLERITH)
-	  && (bt != FFEINFO_basictypeTYPELESS)
-	  && (bt != FFEINFO_basictypeNONE)
-	  && (ai->bt != FFEINFO_basictypeHOLLERITH)
-	  && (ai->bt != FFEINFO_basictypeNONE)
-	  && (ai->bt != FFEINFO_basictypeTYPELESS))
-	{
-	  /* Check types.  */
-
-	  if ((bt != ai->bt)
-	      && ((bt != FFEINFO_basictypeREAL)
-		  || (ai->bt != FFEINFO_basictypeCOMPLEX))
-	      && ((bt != FFEINFO_basictypeCOMPLEX)
-		  || (ai->bt != FFEINFO_basictypeREAL)))
-	    {
-	      if (((bt == FFEINFO_basictypeINTEGER)
-		   && (ai->bt == FFEINFO_basictypeLOGICAL))
-		  || ((bt == FFEINFO_basictypeLOGICAL)
-		   && (ai->bt == FFEINFO_basictypeINTEGER)))
-		warn = TRUE;	/* We can cope with these differences. */
-	      else
-		fail = TRUE;
-	      refwhy = "one type";
-	      defwhy = "some other type";
-	    }
-
-	  if (!fail && !warn && (kt != ai->kt))
-	    {
-	      fail = TRUE;
-	      refwhy = "one precision";
-	      defwhy = "some other precision";
-	    }
-	}
-
-      if (fail && ! g->u.proc.defined)
-	{
-	  /* No point failing if we're worried only about invocations.  */
-	  fail = FALSE;
-	  warn = TRUE;
-	}
-
-      if (fail && ! ffe_is_globals ())
-	{
-	  warn = TRUE;
-	  fail = FALSE;
-	}
-
-      if (fail || (warn && ffe_is_warn_globals ()))
-	{
-	  char num[60];
-
-	  if (ai->name == NULL)
-	    sprintf (&num[0], "%d", argno + 1);
-	  else
-	    {
-	      if (strlen (ai->name) < 30)
-		sprintf (&num[0], "%d (named `%s')", argno + 1, ai->name);
-	      else
-		sprintf (&num[0], "%d (named `%.*s...')", argno + 1, 30, ai->name);
-	    }
-	  ffebad_start (fail ? FFEBAD_FILEWIDE_ARG : FFEBAD_FILEWIDE_ARG_W);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_string (num);
-	  ffebad_string (refwhy);
-	  ffebad_string (defwhy);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (ai->t), ffelex_token_where_column (ai->t));
-	  ffebad_finish ();
-	  return (fail ? FALSE : TRUE);
-	}
-
-      if (warn)
-	return TRUE;
-    }
-
-  /* Define this argument.  */
-
-  if (ai->t != NULL)
-    ffelex_token_kill (ai->t);
-  if ((as != FFEGLOBAL_argsummaryPROC)
-      || (ai->t == NULL))
-    ai->as = as;
-  ai->t = ffelex_token_use (g->t);
-  ai->name = NULL;
-  ai->bt = bt;
-  ai->kt = kt;
-  ai->array = array;
-  return TRUE;
-}
-
-bool
-ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t)
-{
-  ffeglobal g = ffesymbol_global (s);
-
-  assert (g != NULL);
-
-  if (g->type == FFEGLOBAL_typeANY)
-    return FALSE;
-
-  if (g->u.proc.n_args >= 0)
-    {
-      if (g->u.proc.n_args == n_args)
-	return TRUE;
-
-      if (g->u.proc.defined && ffe_is_globals ())
-	{
-	  ffebad_start (FFEBAD_FILEWIDE_NARGS);
-	  ffebad_string (ffesymbol_text (s));
-	  if (g->u.proc.n_args > n_args)
-	    ffebad_string ("few");
-	  else
-	    ffebad_string ("many");
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	  return FALSE;
-	}
-
-      if (ffe_is_warn_globals ())
-	{
-	  ffebad_start (FFEBAD_FILEWIDE_NARGS_W);
-	  ffebad_string (ffesymbol_text (s));
-	  if (g->u.proc.n_args > n_args)
-	    ffebad_string ("few");
-	  else
-	    ffebad_string ("many");
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-
-      return TRUE;		/* Don't replace the info we already have. */
-    }
-
-  /* This is new info we can use in cross-checking future references
-     and a possible future definition.  */
-
-  g->u.proc.n_args = n_args;
-  g->u.proc.other_t = ffelex_token_use (t);
-
-  /* Make this "the" place we found the global, since it has the most info.  */
-
-  if (g->t != NULL)
-    ffelex_token_kill (g->t);
-  g->t = ffelex_token_use (t);
-
-  if (n_args == 0)
-    {
-      g->u.proc.arg_info = NULL;
-      return TRUE;
-    }
-
-  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;
-
-  return TRUE;
-}
-
-/* Return a global for a promoted symbol (one that has heretofore
-   been assumed to be local, but since discovered to be global).  */
-
-ffeglobal
-ffeglobal_promoted (ffesymbol s)
-{
-#if FFEGLOBAL_ENABLED
-  ffename n;
-  ffeglobal g;
-
-  assert (ffesymbol_global (s) == NULL);
-
-  n = ffename_find (ffeglobal_filewide_, ffename_token (ffesymbol_name (s)));
-  g = ffename_global (n);
-
-  return g;
-#else
-  return NULL;
-#endif
-}
-
-/* Register a reference to an intrinsic.  Such a reference is always
-   valid, though a warning might be in order if the same name has
-   already been used for a global.  */
-
-void
-ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit)
-{
-#if FFEGLOBAL_ENABLED
-  ffename n;
-  ffeglobal g;
-
-  if (ffesymbol_global (s) == NULL)
-    {
-      n = ffename_find (ffeglobal_filewide_, t);
-      g = ffename_global (n);
-    }
-  else
-    {
-      g = ffesymbol_global (s);
-      n = NULL;
-    }
-
-  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
-    return;
-
-  if ((g != NULL) && (g->type != FFEGLOBAL_typeNONE))
-    {
-      if (! explicit
-	  && ! g->intrinsic
-	  && ffe_is_warn_globals ())
-	{
-	  /* This name, previously used as a global, now is used
-	     for an intrinsic.  Warn, since this new use as an
-	     intrinsic might have been intended to refer to
-	     the global procedure.  */
-	  ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_string ("intrinsic");
-	  ffebad_string ("global");
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-    }
-  else
-    {
-      if (g == NULL)
-	{
-	  g = ffeglobal_new_ (n);
-	  g->tick = ffe_count_2;
-	  g->type = FFEGLOBAL_typeNONE;
-	  g->intrinsic = TRUE;
-	  g->explicit_intrinsic = explicit;
-	  g->t = ffelex_token_use (t);
-	}
-      else if (g->intrinsic
-	       && (explicit != g->explicit_intrinsic)
-	       && (g->tick != ffe_count_2)
-	       && ffe_is_warn_globals ())
-	{
-	  /* An earlier reference to this intrinsic disagrees with
-	     this reference vis-a-vis explicit `intrinsic foo',
-	     which suggests that the one relying on implicit
-	     intrinsicacity might have actually intended to refer
-	     to a global of the same name.  */
-	  ffebad_start (FFEBAD_INTRINSIC_EXPIMP);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_string (explicit ? "explicit" : "implicit");
-	  ffebad_string (explicit ? "implicit" : "explicit");
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	}
-    }
-
-  g->intrinsic = TRUE;
-  if (explicit)
-    g->explicit_intrinsic = TRUE;
-
-  ffesymbol_set_global (s, g);
-#endif
-}
-
-/* Register a reference to a global.  Returns TRUE if the reference
-   is valid.  */
-
-bool
-ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type)
-{
-#if FFEGLOBAL_ENABLED
-  ffename n = NULL;
-  ffeglobal g;
-
-  /* It is never really _known_ that an EXTERNAL statement
-     names a BLOCK DATA by just looking at the program unit,
-     so override a different notion here.  */
-  if (type == FFEGLOBAL_typeBDATA)
-    type = FFEGLOBAL_typeEXT;
-
-  g = ffesymbol_global (s);
-  if (g == NULL)
-    {
-      n = ffename_find (ffeglobal_filewide_, t);
-      g = ffename_global (n);
-      if (g != NULL)
-	ffesymbol_set_global (s, g);
-    }
-
-  if ((g != NULL) && (g->type == FFEGLOBAL_typeANY))
-    return TRUE;
-
-  if ((g != NULL)
-      && (g->type != FFEGLOBAL_typeNONE)
-      && (g->type != FFEGLOBAL_typeEXT)
-      && (g->type != type)
-      && (type != FFEGLOBAL_typeEXT))
-    {
-      /* Disagreement about (fully refined) class of program unit
-	 (main, subroutine, function, block data).  Treat EXTERNAL/
-	 COMMON disagreements distinctly.  */
-      if ((((type == FFEGLOBAL_typeBDATA)
-	    && (g->type != FFEGLOBAL_typeCOMMON))
-	   || ((g->type == FFEGLOBAL_typeBDATA)
-	       && (type != FFEGLOBAL_typeCOMMON)
-	       && ! g->u.proc.defined)))
-	{
-#if 0	/* This is likely to just annoy people. */
-	  if (ffe_is_warn_globals ())
-	    {
-	      /* Warn about EXTERNAL of a COMMON name, though it works.  */
-	      ffebad_start (FFEBAD_FILEWIDE_TIFF);
-	      ffebad_string (ffelex_token_text (t));
-	      ffebad_string (ffeglobal_type_string_[type]);
-	      ffebad_string (ffeglobal_type_string_[g->type]);
-	      ffebad_here (0, ffelex_token_where_line (t),
-			   ffelex_token_where_column (t));
-	      ffebad_here (1, ffelex_token_where_line (g->t),
-			   ffelex_token_where_column (g->t));
-	      ffebad_finish ();
-	    }
-#endif
-	}
-      else if (ffe_is_globals () || ffe_is_warn_globals ())
-	{
-	  ffebad_start (ffe_is_globals ()
-			? FFEBAD_FILEWIDE_DISAGREEMENT
-			: FFEBAD_FILEWIDE_DISAGREEMENT_W);
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_string (ffeglobal_type_string_[type]);
-	  ffebad_string (ffeglobal_type_string_[g->type]);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_here (1, ffelex_token_where_line (g->t),
-		       ffelex_token_where_column (g->t));
-	  ffebad_finish ();
-	  g->type = FFEGLOBAL_typeANY;
-	  return (! ffe_is_globals ());
-	}
-    }
-
-  if ((g != NULL)
-      && (type == FFEGLOBAL_typeFUNC))
-    {
-      /* If just filling in this function's type, do so.  */
-      if ((g->tick == ffe_count_2)
-	  && (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
-	  && (ffesymbol_kindtype (s) != FFEINFO_kindtypeNONE))
-	{
-	  g->u.proc.bt = ffesymbol_basictype (s);
-	  g->u.proc.kt = ffesymbol_kindtype (s);
-	  g->u.proc.sz = ffesymbol_size (s);
-	}
-      /* Make sure there is type agreement.  */
-      if (g->type == FFEGLOBAL_typeFUNC
-	  && g->u.proc.bt != FFEINFO_basictypeNONE
-	  && ffesymbol_basictype (s) != FFEINFO_basictypeNONE
-	  && (ffesymbol_basictype (s) != g->u.proc.bt
-	      || ffesymbol_kindtype (s) != g->u.proc.kt
-	      /* CHARACTER*n disagreements matter only once a
-		 definition is involved, since the definition might
-		 be CHARACTER*(*), which accepts all references.  */
-	      || (g->u.proc.defined
-		  && ffesymbol_size (s) != g->u.proc.sz
-		  && ffesymbol_size (s) != FFETARGET_charactersizeNONE
-		  && g->u.proc.sz != FFETARGET_charactersizeNONE)))
-	{
-	  int error;
-
-	  /* Type mismatch between function reference/definition and
-	     this subsequent reference (which might just be the filling-in
-	     of type info for the definition, but we can't reach here
-	     if that's the case and there was a previous definition).
-
-	     It's an error given a previous definition, since that
-	     implies inlining can crash the compiler, unless the user
-	     asked for no such inlining.  */
-	  error = (g->tick != ffe_count_2
-		   && g->u.proc.defined
-		   && ffe_is_globals ());
-	  if (error || ffe_is_warn_globals ())
-	    {
-	      ffebad_start (error
-			    ? FFEBAD_FILEWIDE_TYPE_MISMATCH
-			    : FFEBAD_FILEWIDE_TYPE_MISMATCH_W);
-	      ffebad_string (ffelex_token_text (t));
-	      if (g->tick == ffe_count_2)
-		{
-		  /* Current reference fills in type info for definition.
-		     The current token doesn't necessarily point to the actual
-		     definition of the function, so use the definition pointer
-		     and the pointer to the pre-definition type info.  */
-		  ffebad_here (0, ffelex_token_where_line (g->t),
-			       ffelex_token_where_column (g->t));
-		  ffebad_here (1, ffelex_token_where_line (g->u.proc.other_t),
-			       ffelex_token_where_column (g->u.proc.other_t));
-		}
-	      else
-		{
-		  /* Current reference is not a filling-in of a current
-		     definition.  The current token is fine, as is
-		     the previous-mention token.  */
-		  ffebad_here (0, ffelex_token_where_line (t),
-			       ffelex_token_where_column (t));
-		  ffebad_here (1, ffelex_token_where_line (g->t),
-			       ffelex_token_where_column (g->t));
-		}
-	      ffebad_finish ();
-	      if (error)
-		g->type = FFEGLOBAL_typeANY;
-	      return FALSE;
-	    }
-	}
-    }
-
-  if (g == NULL)
-    {
-      g = ffeglobal_new_ (n);
-      g->t = ffelex_token_use (t);
-      g->tick = ffe_count_2;
-      g->intrinsic = FALSE;
-      g->type = type;
-      g->u.proc.defined = FALSE;
-      g->u.proc.bt = ffesymbol_basictype (s);
-      g->u.proc.kt = ffesymbol_kindtype (s);
-      g->u.proc.sz = ffesymbol_size (s);
-      g->u.proc.n_args = -1;
-      ffesymbol_set_global (s, g);
-    }
-  else if (g->intrinsic
-	   && !g->explicit_intrinsic
-	   && (g->tick != ffe_count_2)
-	   && ffe_is_warn_globals ())
-    {
-      /* Now known as a global, this name previously was seen as an
-	 intrinsic.  Warn, in case the previous reference was intended
-	 for the same global.  */
-      ffebad_start (FFEBAD_INTRINSIC_GLOBAL);
-      ffebad_string (ffelex_token_text (t));
-      ffebad_string ("global");
-      ffebad_string ("intrinsic");
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_here (1, ffelex_token_where_line (g->t),
-		   ffelex_token_where_column (g->t));
-      ffebad_finish ();
-    }
-
-  if ((g->type != type)
-      && (type != FFEGLOBAL_typeEXT))
-    {
-      /* We've learned more, so point to where we learned it.  */
-      g->t = ffelex_token_use (t);
-      g->type = type;
-      g->hook = FFECOM_globalNULL;	/* Discard previous _DECL. */
-      g->u.proc.n_args = -1;
-    }
-
-  return TRUE;
-#endif
-}
-
-/* ffeglobal_save_common -- Check SAVE status of common area
-
-   ffesymbol s;	 // the common area
-   bool save;  // TRUE if SAVEd, FALSE otherwise
-   ffeglobal_save_common(s,save,ffesymbol_where_line(s),
-	 ffesymbol_where_column(s));
-
-   In global-enabled mode, make sure the save info agrees with any existing
-   info established for the common area, otherwise complain.
-   In global-disabled mode, do nothing.	 */
-
-void
-ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
-		       ffewhereColumn wc)
-{
-#if FFEGLOBAL_ENABLED
-  ffeglobal g;
-
-  g = ffesymbol_global (s);
-  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
-    return;			/* Let someone else catch this! */
-  if (g->type == FFEGLOBAL_typeANY)
-    return;
-
-  if (!g->u.common.have_save)
-    {
-      g->u.common.have_save = TRUE;
-      g->u.common.save = save;
-      g->u.common.save_where_line = ffewhere_line_use (wl);
-      g->u.common.save_where_col = ffewhere_column_use (wc);
-    }
-  else
-    {
-      if ((g->u.common.save != save) && ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_COMMON_DIFF_SAVE);
-	  ffebad_string (ffesymbol_text (s));
-	  ffebad_here (save ? 0 : 1, wl, wc);
-	  ffebad_here (save ? 1 : 0, g->u.common.pad_where_line, g->u.common.pad_where_col);
-	  ffebad_finish ();
-	}
-    }
-#endif
-}
-
-/* ffeglobal_size_common -- Establish size of COMMON area
-
-   ffesymbol s;	 // the common area
-   ffetargetOffset size;  // size in units
-   if (ffeglobal_size_common(s,size))  // new size is largest seen
-
-   In global-enabled mode, set the size if it current size isn't known or is
-   smaller than new size, and for non-blank common, complain if old size
-   is different from new.  Return TRUE if the new size is the largest seen
-   for this COMMON area (or if no size was known for it previously).
-   In global-disabled mode, do nothing.	 */
-
-#if FFEGLOBAL_ENABLED
-bool
-ffeglobal_size_common (ffesymbol s, ffetargetOffset size)
-{
-  ffeglobal g;
-
-  g = ffesymbol_global (s);
-  if ((g == NULL) || (g->type != FFEGLOBAL_typeCOMMON))
-    return FALSE;
-  if (g->type == FFEGLOBAL_typeANY)
-    return FALSE;
-
-  if (!g->u.common.have_size)
-    {
-      g->u.common.have_size = TRUE;
-      g->u.common.size = size;
-      return TRUE;
-    }
-
-  if ((g->tick > 0) && (g->tick < ffe_count_2)
-      && (g->u.common.size < size))
-    {
-      char oldsize[40];
-      char newsize[40];
-
-      /* Common block initialized in a previous program unit, which
-	 effectively freezes its size, but now the program is trying
-	 to enlarge it.  */
-
-      sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
-      sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
-
-      ffebad_start (FFEBAD_COMMON_ENLARGED);
-      ffebad_string (ffesymbol_text (s));
-      ffebad_string (oldsize);
-      ffebad_string (newsize);
-      ffebad_string ((g->u.common.size == 1)
-		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-      ffebad_string ((size == 1)
-		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-      ffebad_here (0, ffelex_token_where_line (g->u.common.initt),
-		   ffelex_token_where_column (g->u.common.initt));
-      ffebad_here (1, ffesymbol_where_line (s),
-		   ffesymbol_where_column (s));
-      ffebad_finish ();
-    }
-  else if ((g->u.common.size != size) && !g->u.common.blank)
-    {
-      char oldsize[40];
-      char newsize[40];
-
-      /* Warn about this even if not -pedantic, because putting all
-	 program units in a single source file is the only way to
-	 detect this.  Apparently UNIX-model linkers neither handle
-	 nor report when they make a common unit smaller than
-	 requested, such as when the smaller-declared version is
-	 initialized and the larger-declared version is not.  So
-	 if people complain about strange overwriting, we can tell
-	 them to put all their code in a single file and compile
-	 that way.  Warnings about differing sizes must therefore
-	 always be issued.  */
-
-      sprintf (&oldsize[0], "%" ffetargetOffset_f "d", g->u.common.size);
-      sprintf (&newsize[0], "%" ffetargetOffset_f "d", size);
-
-      ffebad_start (FFEBAD_COMMON_DIFF_SIZE);
-      ffebad_string (ffesymbol_text (s));
-      ffebad_string (oldsize);
-      ffebad_string (newsize);
-      ffebad_string ((g->u.common.size == 1)
-		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-      ffebad_string ((size == 1)
-		     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-      ffebad_here (0, ffelex_token_where_line (g->t),
-		   ffelex_token_where_column (g->t));
-      ffebad_here (1, ffesymbol_where_line (s),
-		   ffesymbol_where_column (s));
-      ffebad_finish ();
-    }
-
-  if (size > g->u.common.size)
-    {
-      g->u.common.size = size;
-      return TRUE;
-    }
-
-  return FALSE;
-}
-
-#endif
-void
-ffeglobal_terminate_1 (void)
-{
-}
diff --git a/gcc/f/global.h b/gcc/f/global.h
deleted file mode 100644
index dc499df..0000000
--- a/gcc/f/global.h
+++ /dev/null
@@ -1,193 +0,0 @@
-/* global.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      global.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_GLOBAL_H
-#define GCC_F_GLOBAL_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFEGLOBAL_typeNONE,
-    FFEGLOBAL_typeMAIN,
-    FFEGLOBAL_typeEXT,		/* EXTERNAL is all we know. */
-    FFEGLOBAL_typeSUBR,
-    FFEGLOBAL_typeFUNC,
-    FFEGLOBAL_typeBDATA,
-    FFEGLOBAL_typeCOMMON,
-    FFEGLOBAL_typeANY,		/* Confusion reigns, so just ignore. */
-    FFEGLOBAL_type
-  } ffeglobalType;
-
-typedef enum
-  {
-    FFEGLOBAL_argsummaryNONE,	/* No arg present. */
-    FFEGLOBAL_argsummaryVAL,	/* Pass-by-value. */
-    FFEGLOBAL_argsummaryREF,	/* Pass-by-reference. */
-    FFEGLOBAL_argsummaryDESCR,	/* Pass-by-descriptor. */
-    FFEGLOBAL_argsummaryPROC,	/* Procedure (intrinsic, external). */
-    FFEGLOBAL_argsummarySUBR,	/* Subroutine (intrinsic, external). */
-    FFEGLOBAL_argsummaryFUNC,	/* Function (intrinsic, external). */
-    FFEGLOBAL_argsummaryALTRTN,	/* Alternate-return (label). */
-    FFEGLOBAL_argsummaryANY,
-    FFEGLOBAL_argsummary
-  } ffeglobalArgSummary;
-
-/* Typedefs. */
-
-typedef struct _ffeglobal_arginfo_ *ffeglobalArgInfo_;
-typedef struct _ffeglobal_ *ffeglobal;
-
-/* Include files needed by this one. */
-
-#include "info.h"
-#include "lex.h"
-#include "name.h"
-#include "symbol.h"
-#include "target.h"
-#include "top.h"
-
-/* Structure definitions. */
-
-struct _ffeglobal_arginfo_
-{
-  ffelexToken t;	/* Different from master token when difference is important. */
-  char *name;		/* Name of dummy arg, or NULL if not yet known. */
-  ffeglobalArgSummary as;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  bool array;
-};
-
-struct _ffeglobal_
-{
-  ffelexToken t;
-  ffename n;
-  ffecomGlobal hook;
-  ffeCounter tick;		/* Recent transition in this progunit. */
-  ffeglobalType type;
-  bool intrinsic;		/* Known as intrinsic? */
-  bool explicit_intrinsic;	/* Explicit intrinsic? */
-  union {
-    struct {
-      ffelexToken initt;	/* First initial value. */
-      bool have_pad;		/* Padding info avail for COMMON? */
-      ffetargetAlign pad;	/* Initial padding for COMMON. */
-      ffewhereLine pad_where_line;
-      ffewhereColumn pad_where_col;
-      bool have_save;		/* Save info avail for COMMON? */
-      bool save;		/* Save info for COMMON. */
-      ffewhereLine save_where_line;
-      ffewhereColumn save_where_col;
-      bool have_size;		/* Size info avail for COMMON? */
-      ffetargetOffset size;	/* Size info for COMMON. */
-      bool blank;		/* TRUE if blank COMMON. */
-    } common;
-    struct {
-      bool defined;		/* Seen actual code yet? */
-      ffeinfoBasictype bt;	/* NONE for non-function. */
-      ffeinfoKindtype kt;	/* NONE for non-function. */
-      ffetargetCharacterSize sz;
-      int n_args;		/* 0 for main/blockdata. */
-      ffelexToken other_t;	/* Location of reference. */
-      ffeglobalArgInfo_ arg_info;	/* Info on each argument. */
-    } proc;
-  } u;
-};
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffeglobal_drive (ffeglobal (*fn) (ffeglobal));
-void ffeglobal_init_1 (void);
-void ffeglobal_init_common (ffesymbol s, ffelexToken t);
-void ffeglobal_new_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
-void ffeglobal_new_common (ffesymbol s, ffelexToken t, bool blank);
-void ffeglobal_pad_common (ffesymbol s, ffetargetAlign pad, ffewhereLine wl,
-			   ffewhereColumn wc);
-void ffeglobal_proc_def_arg (ffesymbol s, int argno, const char *name, ffeglobalArgSummary as,
-			     ffeinfoBasictype bt, ffeinfoKindtype kt,
-			     bool array);
-void ffeglobal_proc_def_nargs (ffesymbol s, int n_args);
-bool ffeglobal_proc_ref_arg (ffesymbol s, int argno, ffeglobalArgSummary as,
-			     ffeinfoBasictype bt, ffeinfoKindtype kt,
-			     bool array, ffelexToken t);
-bool ffeglobal_proc_ref_nargs (ffesymbol s, int n_args, ffelexToken t);
-ffeglobal ffeglobal_promoted (ffesymbol s);
-void ffeglobal_ref_intrinsic (ffesymbol s, ffelexToken t, bool explicit);
-bool ffeglobal_ref_progunit_ (ffesymbol s, ffelexToken t, ffeglobalType type);
-void ffeglobal_save_common (ffesymbol s, bool save, ffewhereLine wl,
-			    ffewhereColumn wc);
-bool ffeglobal_size_common (ffesymbol s, ffetargetOffset size);
-void ffeglobal_terminate_1 (void);
-
-/* Define macros. */
-
-#define FFEGLOBAL_ENABLED 1
-
-#define ffeglobal_common_init(g) ((g)->tick != 0)
-#define ffeglobal_common_have_pad(g) ((g)->u.common.have_pad)
-#define ffeglobal_common_have_size(g) ((g)->u.common.have_size)
-#define ffeglobal_common_pad(g) ((g)->u.common.pad)
-#define ffeglobal_common_size(g) ((g)->u.common.size)
-#define ffeglobal_hook(g) ((g)->hook)
-#define ffeglobal_init_0()
-#define ffeglobal_init_2()
-#define ffeglobal_init_3()
-#define ffeglobal_init_4()
-#define ffeglobal_new_blockdata(s,t) \
-      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeBDATA)
-#define ffeglobal_new_function(s,t) \
-      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeFUNC)
-#define ffeglobal_new_program(s,t) \
-      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeMAIN)
-#define ffeglobal_new_subroutine(s,t) \
-      ffeglobal_new_progunit_(s,t,FFEGLOBAL_typeSUBR)
-#define ffeglobal_ref_blockdata(s,t) \
-      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeBDATA)
-#define ffeglobal_ref_external(s,t) \
-      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeEXT)
-#define ffeglobal_ref_function(s,t) \
-      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeFUNC)
-#define ffeglobal_ref_subroutine(s,t) \
-      ffeglobal_ref_progunit_(s,t,FFEGLOBAL_typeSUBR)
-#define ffeglobal_set_hook(g,h) ((g)->hook = (h))
-#define ffeglobal_terminate_0()
-#define ffeglobal_terminate_2()
-#define ffeglobal_terminate_3()
-#define ffeglobal_terminate_4()
-#define ffeglobal_text(g) ffename_text((g)->n)
-#define ffeglobal_type(g) ((g)->type)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_GLOBAL_H */
-
diff --git a/gcc/f/implic.c b/gcc/f/implic.c
deleted file mode 100644
index c7a28cb..0000000
--- a/gcc/f/implic.c
+++ /dev/null
@@ -1,383 +0,0 @@
-/* implic.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None.
-
-   Description:
-      The GNU Fortran Front End.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "implic.h"
-#include "info.h"
-#include "src.h"
-#include "symbol.h"
-#include "target.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFEIMPLIC_stateINITIAL_,
-    FFEIMPLIC_stateASSUMED_,
-    FFEIMPLIC_stateESTABLISHED_,
-    FFEIMPLIC_state
-  } ffeimplicState_;
-
-/* Internal typedefs. */
-
-typedef struct _ffeimplic_ *ffeimplic_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffeimplic_
-  {
-    ffeimplicState_ state;
-    ffeinfo info;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-/* NOTE: This is definitely ASCII-specific!!  */
-
-static struct _ffeimplic_ ffeimplic_table_['z' - 'A' + 1];
-
-/* Static functions (internal). */
-
-static ffeimplic_ ffeimplic_lookup_ (unsigned char c);
-
-/* Internal macros. */
-
-
-/* ffeimplic_lookup_ -- Look up implicit descriptor for initial character
-
-   ffeimplic_ imp;
-   if ((imp = ffeimplic_lookup_('A')) == NULL)
-       // error
-
-   Returns a pointer to an implicit descriptor block based on the character
-   passed, or NULL if it is not a valid initial character for an implicit
-   data type.  */
-
-static ffeimplic_
-ffeimplic_lookup_ (unsigned char c)
-{
-  /* NOTE: This is definitely ASCII-specific!!  */
-  if (ISIDST (c))
-    return &ffeimplic_table_[c - 'A'];
-  return NULL;
-}
-
-/* ffeimplic_establish_initial -- Establish type of implicit initial letter
-
-   ffesymbol s;
-   if (!ffeimplic_establish_initial(s))
-       // error
-
-   Assigns implicit type information to the symbol based on the first
-   character of the symbol's name.  */
-
-bool
-ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
-		     ffeinfoKindtype kind_type, ffetargetCharacterSize size)
-{
-  ffeimplic_ imp;
-
-  imp = ffeimplic_lookup_ (c);
-  if (imp == NULL)
-    return FALSE;		/* Character not A-Z or some such thing. */
-  if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
-    return FALSE;		/* IMPLICIT NONE in effect here. */
-
-  switch (imp->state)
-    {
-    case FFEIMPLIC_stateINITIAL_:
-      imp->info = ffeinfo_new (basic_type,
-			       kind_type,
-			       0,
-			       FFEINFO_kindNONE,
-			       FFEINFO_whereNONE,
-			       size);
-      imp->state = FFEIMPLIC_stateESTABLISHED_;
-      return TRUE;
-
-    case FFEIMPLIC_stateASSUMED_:
-      if ((ffeinfo_basictype (imp->info) != basic_type)
-	  || (ffeinfo_kindtype (imp->info) != kind_type)
-	  || (ffeinfo_size (imp->info) != size))
-	return FALSE;
-      imp->state = FFEIMPLIC_stateESTABLISHED_;
-      return TRUE;
-
-    case FFEIMPLIC_stateESTABLISHED_:
-      return FALSE;
-
-    default:
-      assert ("Weird state for implicit object" == NULL);
-      return FALSE;
-    }
-}
-
-/* ffeimplic_establish_symbol -- Establish implicit type of a symbol
-
-   ffesymbol s;
-   if (!ffeimplic_establish_symbol(s))
-       // error
-
-   Assigns implicit type information to the symbol based on the first
-   character of the symbol's name.
-
-   If symbol already has a type, return TRUE.
-   Get first character of symbol's name.
-   Get ffeimplic_ object for it (return FALSE if NULL returned).
-   Return FALSE if object has no assigned type (IMPLICIT NONE).
-   Copy the type information from the object to the symbol.
-   If the object is state "INITIAL", set to state "ASSUMED" so no
-       subsequent IMPLICIT statement may change the state.
-   Return TRUE.	 */
-
-bool
-ffeimplic_establish_symbol (ffesymbol s)
-{
-  char c;
-  ffeimplic_ imp;
-
-  if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
-    return TRUE;
-
-  c = *(ffesymbol_text (s));
-  imp = ffeimplic_lookup_ (c);
-  if (imp == NULL)
-    return FALSE;		/* First character not A-Z or some such
-				   thing. */
-  if (ffeinfo_basictype (imp->info) == FFEINFO_basictypeNONE)
-    return FALSE;		/* IMPLICIT NONE in effect here. */
-
-  ffesymbol_signal_change (s);	/* Gonna change, save existing? */
-
-  /* Establish basictype, kindtype, size; preserve rank, kind, where. */
-
-  ffesymbol_set_info (s,
-		      ffeinfo_new (ffeinfo_basictype (imp->info),
-				   ffeinfo_kindtype (imp->info),
-				   ffesymbol_rank (s),
-				   ffesymbol_kind (s),
-				   ffesymbol_where (s),
-				   ffeinfo_size (imp->info)));
-
-  if (imp->state == FFEIMPLIC_stateINITIAL_)
-    imp->state = FFEIMPLIC_stateASSUMED_;
-
-  if (ffe_is_warn_implicit ())
-    {
-      /* xgettext:no-c-format */
-      ffebad_start_msg ("Implicit declaration of `%A' at %0",
-			FFEBAD_severityWARNING);
-      ffebad_here (0, ffesymbol_where_line (s),
-		   ffesymbol_where_column (s));
-      ffebad_string (ffesymbol_text (s));
-      ffebad_finish ();
-    }
-
-  return TRUE;
-}
-
-/* ffeimplic_init_2 -- Initialize table
-
-   ffeimplic_init_2();
-
-   Assigns initial type information to all initial letters.
-
-   Allows for holes in the sequence of letters (i.e. EBCDIC).  */
-
-void
-ffeimplic_init_2 (void)
-{
-  ffeimplic_ imp;
-  char c;
-
-  for (c = 'A'; c <= 'z'; ++c)
-    {
-      imp = &ffeimplic_table_[c - 'A'];
-      imp->state = FFEIMPLIC_stateINITIAL_;
-      switch (c)
-	{
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case '_':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  imp->info = ffeinfo_new (FFEINFO_basictypeREAL,
-				   FFEINFO_kindtypeREALDEFAULT,
-				   0,
-				   FFEINFO_kindNONE,
-				   FFEINFO_whereNONE,
-				   FFETARGET_charactersizeNONE);
-	  break;
-
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	  imp->info = ffeinfo_new (FFEINFO_basictypeINTEGER,
-				   FFEINFO_kindtypeINTEGERDEFAULT, 0, FFEINFO_kindNONE, FFEINFO_whereNONE,
-				   FFETARGET_charactersizeNONE);
-	  break;
-
-	default:
-	  imp->info = ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0,
-	  FFEINFO_kindNONE, FFEINFO_whereNONE, FFETARGET_charactersizeNONE);
-	  break;
-	}
-    }
-}
-
-/* ffeimplic_none -- Implement IMPLICIT NONE statement
-
-   ffeimplic_none();
-
-   Assigns null type information to all initial letters.  */
-
-void
-ffeimplic_none (void)
-{
-  ffeimplic_ imp;
-
-  for (imp = &ffeimplic_table_[0];
-       imp != &ffeimplic_table_[ARRAY_SIZE (ffeimplic_table_)];
-       imp++)
-    {
-      imp->info = ffeinfo_new (FFEINFO_basictypeNONE,
-			       FFEINFO_kindtypeNONE,
-			       0,
-			       FFEINFO_kindNONE,
-			       FFEINFO_whereNONE,
-			       FFETARGET_charactersizeNONE);
-    }
-}
-
-/* ffeimplic_peek_symbol_type -- Determine implicit type of a symbol
-
-   ffesymbol s;
-   const char *name; // name for s in case it is NULL, or NULL if s never NULL
-   if (ffeimplic_peek_symbol_type(s,name) == FFEINFO_basictypeCHARACTER)
-       // is or will be a CHARACTER-typed name
-
-   Like establish_symbol, but doesn't change anything.
-
-   If symbol is non-NULL and already has a type, return it.
-   Get first character of symbol's name or from name arg if symbol is NULL.
-   Get ffeimplic_ object for it (return FALSE if NULL returned).
-   Return NONE if object has no assigned type (IMPLICIT NONE).
-   Return the data type indicated in the object.
-
-   24-Oct-91  JCB  2.0
-      Take a char * instead of ffelexToken, since the latter isn't always
-      needed anyway (as when ffecom calls it).	*/
-
-ffeinfoBasictype
-ffeimplic_peek_symbol_type (ffesymbol s, const char *name)
-{
-  char c;
-  ffeimplic_ imp;
-
-  if (s == NULL)
-    c = *name;
-  else
-    {
-      if (ffesymbol_basictype (s) != FFEINFO_basictypeNONE)
-	return ffesymbol_basictype (s);
-
-      c = *(ffesymbol_text (s));
-    }
-
-  imp = ffeimplic_lookup_ (c);
-  if (imp == NULL)
-    return FFEINFO_basictypeNONE;	/* First character not A-Z or
-					   something. */
-  return ffeinfo_basictype (imp->info);
-}
-
-/* ffeimplic_terminate_2 -- Terminate table
-
-   ffeimplic_terminate_2();
-
-   Kills info object for each entry in table.  */
-
-void
-ffeimplic_terminate_2 (void)
-{
-}
diff --git a/gcc/f/implic.h b/gcc/f/implic.h
deleted file mode 100644
index 44fbfac..0000000
--- a/gcc/f/implic.h
+++ /dev/null
@@ -1,74 +0,0 @@
-/* implic.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      implic.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_IMPLIC_H
-#define GCC_F_IMPLIC_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "info.h"
-#include "symbol.h"
-#include "target.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-bool ffeimplic_establish_initial (char c, ffeinfoBasictype basic_type,
-		    ffeinfoKindtype kind_type, ffetargetCharacterSize size);
-bool ffeimplic_establish_symbol (ffesymbol s);
-void ffeimplic_init_2 (void);
-void ffeimplic_none (void);
-ffeinfoBasictype ffeimplic_peek_symbol_type (ffesymbol s, const char *name);
-void ffeimplic_terminate_2 (void);
-
-/* Define macros. */
-
-#define ffeimplic_init_0()
-#define ffeimplic_init_1()
-#define ffeimplic_init_3()
-#define ffeimplic_init_4()
-#define ffeimplic_terminate_0()
-#define ffeimplic_terminate_1()
-#define ffeimplic_terminate_3()
-#define ffeimplic_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_IMPLIC_H */
diff --git a/gcc/f/info-b.def b/gcc/f/info-b.def
deleted file mode 100644
index 088d108..0000000
--- a/gcc/f/info-b.def
+++ /dev/null
@@ -1,36 +0,0 @@
-/* info-b.def -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      info.c
-
-   Modifications:
-*/
-
-FFEINFO_BASICTYPE (FFEINFO_basictypeNONE, "None", "")
-FFEINFO_BASICTYPE (FFEINFO_basictypeINTEGER, "INTEGER", "i")
-FFEINFO_BASICTYPE (FFEINFO_basictypeLOGICAL, "LOGICAL", "l")
-FFEINFO_BASICTYPE (FFEINFO_basictypeREAL, "REAL", "r")
-FFEINFO_BASICTYPE (FFEINFO_basictypeCOMPLEX, "COMPLEX", "c")
-FFEINFO_BASICTYPE (FFEINFO_basictypeCHARACTER, "CHARACTER", "a")
-FFEINFO_BASICTYPE (FFEINFO_basictypeHOLLERITH, "Hollerith", "h")
-FFEINFO_BASICTYPE (FFEINFO_basictypeTYPELESS, "Typeless", "t")
-FFEINFO_BASICTYPE (FFEINFO_basictypeANY, "Any", "~")
diff --git a/gcc/f/info-k.def b/gcc/f/info-k.def
deleted file mode 100644
index 9e6052d..0000000
--- a/gcc/f/info-k.def
+++ /dev/null
@@ -1,41 +0,0 @@
-/* info-k.def -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      info.c
-
-   Modifications:
-*/
-
-#
-/* Kind messages are used in diagnostic location reports of the
-   form "<file>: In function `foo': <error message>". */
-
-FFEINFO_KIND (FFEINFO_kindNONE, "In unknown kind", "")
-FFEINFO_KIND (FFEINFO_kindENTITY, "In entity", "e")
-FFEINFO_KIND (FFEINFO_kindFUNCTION, "In function", "f")
-FFEINFO_KIND (FFEINFO_kindSUBROUTINE, "In subroutine", "u")
-FFEINFO_KIND (FFEINFO_kindPROGRAM, "In program", "p")
-FFEINFO_KIND (FFEINFO_kindBLOCKDATA, "In block-data unit", "b")
-FFEINFO_KIND (FFEINFO_kindCOMMON, "In common block", "c")
-FFEINFO_KIND (FFEINFO_kindCONSTRUCT, "In construct", ":")
-FFEINFO_KIND (FFEINFO_kindNAMELIST, "In namelist", "n")
-FFEINFO_KIND (FFEINFO_kindANY, "In anything", "~")
diff --git a/gcc/f/info-w.def b/gcc/f/info-w.def
deleted file mode 100644
index 57e3f8c..0000000
--- a/gcc/f/info-w.def
+++ /dev/null
@@ -1,41 +0,0 @@
-/* info-w.def -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      info.c
-
-   Modifications:
-*/
-
-FFEINFO_WHERE (FFEINFO_whereNONE, "None", "")
-FFEINFO_WHERE (FFEINFO_whereLOCAL, "Local", "l")	/* Defined locally. */
-FFEINFO_WHERE (FFEINFO_whereCOMMON, "Common", "c")	/* In a common area. */
-FFEINFO_WHERE (FFEINFO_whereDUMMY, "Dummy", "d")	/* A dummy argument. */
-FFEINFO_WHERE (FFEINFO_whereGLOBAL, "Global", "g")	/* Reference to external global like FUNCTION, SUBR. */
-FFEINFO_WHERE (FFEINFO_whereRESULT, "Result", "r")	/* Result of this function. */
-FFEINFO_WHERE (FFEINFO_whereFLEETING, "Fleeting", "f")		/* Result of "X*Y", "FUNCREF(5,1.3)", "ARRAY(X)", etc. */
-FFEINFO_WHERE (FFEINFO_whereFLEETING_CADDR, "Fleet-Const", "fp")	/* "A(3)", "CHARS(4:5)". */
-FFEINFO_WHERE (FFEINFO_whereFLEETING_IADDR, "Fleet-Immed", "fi")	/* A(IX) in "DATA (A(IX),IX=1,100)/.../". */
-FFEINFO_WHERE (FFEINFO_whereIMMEDIATE, "Immediate", "i")	/* IX in "DATA (A(IX),IX=1,100)/.../". */
-FFEINFO_WHERE (FFEINFO_whereINTRINSIC, "Intrinsic", "b")
-FFEINFO_WHERE (FFEINFO_whereCONSTANT, "Constant", "p")		/* For kindFUNCTION, means statement function! */
-FFEINFO_WHERE (FFEINFO_whereCONSTANT_SUBOBJECT, "Const-subobj", "q")	/* As in "'FOO'(I:J)". */
-FFEINFO_WHERE (FFEINFO_whereANY, "Any", "~")
diff --git a/gcc/f/info.c b/gcc/f/info.c
deleted file mode 100644
index 3c0030f..0000000
--- a/gcc/f/info.c
+++ /dev/null
@@ -1,303 +0,0 @@
-/* info.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      An abstraction for information maintained on a per-operator and per-
-      operand basis in expression trees.
-
-   Modifications:
-      30-Aug-90	 JCB  2.0
-	 Extensive rewrite for new cleaner approach.
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "info.h"
-#include "target.h"
-#include "type.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module.	 */
-
-static const char *const ffeinfo_basictype_string_[]
-=
-{
-#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) SNAM,
-#include "info-b.def"
-#undef FFEINFO_BASICTYPE
-};
-static const char *const ffeinfo_kind_message_[]
-=
-{
-#define FFEINFO_KIND(kwd,msgid,snam) msgid,
-#include "info-k.def"
-#undef FFEINFO_KIND
-};
-static const char *const ffeinfo_kind_string_[]
-=
-{
-#define FFEINFO_KIND(KWD,LNAM,SNAM) SNAM,
-#include "info-k.def"
-#undef FFEINFO_KIND
-};
-static ffeinfoBasictype ffeinfo_combine_[FFEINFO_basictype][FFEINFO_basictype];
-static const char *const ffeinfo_kindtype_string_[]
-=
-{
-  "",
-  "1",
-  "2",
-  "3",
-  "4",
-  "5",
-  "6",
-  "7",
-  "8",
-  "*",
-};
-static const char *const ffeinfo_where_string_[]
-=
-{
-#define FFEINFO_WHERE(KWD,LNAM,SNAM) SNAM,
-#include "info-w.def"
-#undef FFEINFO_WHERE
-};
-static ffetype ffeinfo_types_[FFEINFO_basictype][FFEINFO_kindtype];
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffeinfo_basictype_combine -- Combine two basictypes into highest rank type
-
-   ffeinfoBasictype i, j, k;
-   k = ffeinfo_basictype_combine(i,j);
-
-   Returns a type based on "standard" operation between two given types.  */
-
-ffeinfoBasictype
-ffeinfo_basictype_combine (ffeinfoBasictype l, ffeinfoBasictype r)
-{
-  assert (l < FFEINFO_basictype);
-  assert (r < FFEINFO_basictype);
-  return ffeinfo_combine_[l][r];
-}
-
-/* ffeinfo_basictype_string -- Return tiny string showing the basictype
-
-   ffeinfoBasictype i;
-   printf("%s",ffeinfo_basictype_string(dt));
-
-   Returns the string based on the basic type.	*/
-
-const char *
-ffeinfo_basictype_string (ffeinfoBasictype basictype)
-{
-  if (basictype >= ARRAY_SIZE (ffeinfo_basictype_string_))
-    return "?\?\?";
-  return ffeinfo_basictype_string_[basictype];
-}
-
-/* ffeinfo_init_0 -- Initialize
-
-   ffeinfo_init_0();  */
-
-void
-ffeinfo_init_0 (void)
-{
-  ffeinfoBasictype i;
-  ffeinfoBasictype j;
-
-  assert (FFEINFO_basictype == ARRAY_SIZE (ffeinfo_basictype_string_));
-  assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_message_));
-  assert (FFEINFO_kind == ARRAY_SIZE (ffeinfo_kind_string_));
-  assert (FFEINFO_kindtype == ARRAY_SIZE (ffeinfo_kindtype_string_));
-  assert (FFEINFO_where == ARRAY_SIZE (ffeinfo_where_string_));
-
-  /* Make array that, given two basic types, produces resulting basic type. */
-
-  for (i = 0; i < FFEINFO_basictype; ++i)
-    for (j = 0; j < FFEINFO_basictype; ++j)
-      if ((i == FFEINFO_basictypeANY) || (j == FFEINFO_basictypeANY))
-	ffeinfo_combine_[i][j] = FFEINFO_basictypeANY;
-      else
-	ffeinfo_combine_[i][j] = FFEINFO_basictypeNONE;
-
-#define same(bt) ffeinfo_combine_[bt][bt] = bt
-#define use2(bt1,bt2) ffeinfo_combine_[bt1][bt2]  \
-      = ffeinfo_combine_[bt2][bt1] = bt2
-
-  same (FFEINFO_basictypeINTEGER);
-  same (FFEINFO_basictypeLOGICAL);
-  same (FFEINFO_basictypeREAL);
-  same (FFEINFO_basictypeCOMPLEX);
-  same (FFEINFO_basictypeCHARACTER);
-  use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeREAL);
-  use2 (FFEINFO_basictypeINTEGER, FFEINFO_basictypeCOMPLEX);
-  use2 (FFEINFO_basictypeREAL, FFEINFO_basictypeCOMPLEX);
-
-#undef same
-#undef use2
-}
-
-/* ffeinfo_kind_message -- Return helpful string showing the kind
-
-   ffeinfoKind kind;
-   printf("%s",ffeinfo_kind_message(kind));
-
-   Returns the string based on the kind.  */
-
-const char *
-ffeinfo_kind_message (ffeinfoKind kind)
-{
-  if (kind >= ARRAY_SIZE (ffeinfo_kind_message_))
-    return "?\?\?";
-  return ffeinfo_kind_message_[kind];
-}
-
-/* ffeinfo_kind_string -- Return tiny string showing the kind
-
-   ffeinfoKind kind;
-   printf("%s",ffeinfo_kind_string(kind));
-
-   Returns the string based on the kind.  */
-
-const char *
-ffeinfo_kind_string (ffeinfoKind kind)
-{
-  if (kind >= ARRAY_SIZE (ffeinfo_kind_string_))
-    return "?\?\?";
-  return ffeinfo_kind_string_[kind];
-}
-
-ffeinfoKindtype
-ffeinfo_kindtype_max(ffeinfoBasictype bt,
-		     ffeinfoKindtype k1,
-		     ffeinfoKindtype k2)
-{
-  if ((bt == FFEINFO_basictypeANY)
-      || (k1 == FFEINFO_kindtypeANY)
-      || (k2 == FFEINFO_kindtypeANY))
-    return FFEINFO_kindtypeANY;
-
-  if (ffetype_size (ffeinfo_types_[bt][k1])
-      > ffetype_size (ffeinfo_types_[bt][k2]))
-    return k1;
-  return k2;
-}
-
-/* ffeinfo_kindtype_string -- Return tiny string showing the kind type
-
-   ffeinfoKindtype kind_type;
-   printf("%s",ffeinfo_kindtype_string(kind));
-
-   Returns the string based on the kind type.  */
-
-const char *
-ffeinfo_kindtype_string (ffeinfoKindtype kind_type)
-{
-  if (kind_type >= ARRAY_SIZE (ffeinfo_kindtype_string_))
-    return "?\?\?";
-  return ffeinfo_kindtype_string_[kind_type];
-}
-
-void
-ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
-		  ffetype type)
-{
-  assert (basictype < FFEINFO_basictype);
-  assert (kindtype < FFEINFO_kindtype);
-  assert (ffeinfo_types_[basictype][kindtype] == NULL);
-
-  ffeinfo_types_[basictype][kindtype] = type;
-}
-
-ffetype
-ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype)
-{
-  assert (basictype < FFEINFO_basictype);
-  assert (kindtype < FFEINFO_kindtype);
-
-  return ffeinfo_types_[basictype][kindtype];
-}
-
-/* ffeinfo_where_string -- Return tiny string showing the where
-
-   ffeinfoWhere where;
-   printf("%s",ffeinfo_where_string(where));
-
-   Returns the string based on the where.  */
-
-const char *
-ffeinfo_where_string (ffeinfoWhere where)
-{
-  if (where >= ARRAY_SIZE (ffeinfo_where_string_))
-    return "?\?\?";
-  return ffeinfo_where_string_[where];
-}
-
-/* ffeinfo_new -- Return object representing datatype, kind, and where info
-
-   ffeinfo i;
-   i = ffeinfo_new(FFEINFO_datatypeINTEGER,FFEINFO_kindSCALAR,
-       FFEINFO_whereLOCAL);
-
-   Returns the string based on the data type.  */
-
-#ifndef __GNUC__
-ffeinfo
-ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
-	     ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
-	     ffetargetCharacterSize size)
-{
-  ffeinfo i;
-
-  i.basictype = basictype;
-  i.kindtype = kindtype;
-  i.rank = rank;
-  i.size = size;
-  i.kind = kind;
-  i.where = where;
-  i.size = size;
-
-  return i;
-}
-#endif
diff --git a/gcc/f/info.h b/gcc/f/info.h
deleted file mode 100644
index 69defd2..0000000
--- a/gcc/f/info.h
+++ /dev/null
@@ -1,186 +0,0 @@
-/* info.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      info.c
-
-   Modifications:
-      30-Aug-90	 JCB  2.0
-	 Extensive rewrite for new cleaner approach.
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_INFO_H
-#define GCC_F_INFO_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-#define FFEINFO_BASICTYPE(KWD,LNAM,SNAM) KWD,
-#include "info-b.def"
-#undef FFEINFO_BASICTYPE
-    FFEINFO_basictype
-  } ffeinfoBasictype;
-
-typedef enum
-  {				/* If these kindtypes aren't in size order,
-				   change _kindtype_max. */
-    FFEINFO_kindtypeNONE,
-    FFEINFO_kindtypeINTEGER1,
-    FFEINFO_kindtypeINTEGER2,
-    FFEINFO_kindtypeINTEGER3,
-    FFEINFO_kindtypeINTEGER4,
-    FFEINFO_kindtypeINTEGER5,
-    FFEINFO_kindtypeINTEGER6,
-    FFEINFO_kindtypeINTEGER7,
-    FFEINFO_kindtypeINTEGER8,
-    FFEINFO_kindtypeLOGICAL1 = 1,	/* Ok to omit, but ok to overlap. */
-    FFEINFO_kindtypeLOGICAL2,
-    FFEINFO_kindtypeLOGICAL3,
-    FFEINFO_kindtypeLOGICAL4,
-    FFEINFO_kindtypeLOGICAL5,
-    FFEINFO_kindtypeLOGICAL6,
-    FFEINFO_kindtypeLOGICAL7,
-    FFEINFO_kindtypeLOGICAL8,
-    FFEINFO_kindtypeREAL1 = 1,	/* Ok to omit, but ok to overlap. */
-    FFEINFO_kindtypeREAL2,
-    FFEINFO_kindtypeREAL3,
-    FFEINFO_kindtypeREAL4,
-    FFEINFO_kindtypeREAL5,
-    FFEINFO_kindtypeREAL6,
-    FFEINFO_kindtypeREAL7,
-    FFEINFO_kindtypeREAL8,
-    FFEINFO_kindtypeCHARACTER1 = 1,	/* Ok to omit, but ok to overlap. */
-    FFEINFO_kindtypeCHARACTER2,
-    FFEINFO_kindtypeCHARACTER3,
-    FFEINFO_kindtypeCHARACTER4,
-    FFEINFO_kindtypeCHARACTER5,
-    FFEINFO_kindtypeCHARACTER6,
-    FFEINFO_kindtypeCHARACTER7,
-    FFEINFO_kindtypeCHARACTER8,
-    FFEINFO_kindtypeANY,
-    FFEINFO_kindtype
-  } ffeinfoKindtype;
-
-typedef enum
-  {
-#define FFEINFO_KIND(KWD,LNAM,SNAM) KWD,
-#include "info-k.def"
-#undef FFEINFO_KIND
-    FFEINFO_kind
-  } ffeinfoKind;
-
-typedef enum
-  {
-#define FFEINFO_WHERE(KWD,LNAM,SNAM) KWD,
-#include "info-w.def"
-#undef FFEINFO_WHERE
-    FFEINFO_where
-  } ffeinfoWhere;
-
-/* Typedefs. */
-
-typedef struct _ffeinfo_ ffeinfo;
-typedef char ffeinfoRank;
-
-/* Include files needed by this one. */
-
-#include "target.h"
-#include "type.h"
-
-/* Structure definitions. */
-
-struct _ffeinfo_
-  {
-    ffeinfoBasictype basictype;
-    ffeinfoKindtype kindtype;
-    ffeinfoRank rank;
-    ffeinfoKind kind;
-    ffeinfoWhere where;
-    ffetargetCharacterSize size;
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-ffeinfoBasictype ffeinfo_basictype_combine (ffeinfoBasictype l,
-					    ffeinfoBasictype r);
-const char *ffeinfo_basictype_string (ffeinfoBasictype basictype);
-void ffeinfo_init_0 (void);
-const char *ffeinfo_kind_message (ffeinfoKind kind);
-const char *ffeinfo_kind_string (ffeinfoKind kind);
-ffeinfoKindtype ffeinfo_kindtype_max(ffeinfoBasictype bt,
-				     ffeinfoKindtype k1,
-				     ffeinfoKindtype k2);
-const char *ffeinfo_kindtype_string (ffeinfoKindtype kind_type);
-const char *ffeinfo_where_string (ffeinfoWhere where);
-ffeinfo ffeinfo_new (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
-		     ffeinfoRank rank, ffeinfoKind kind, ffeinfoWhere where,
-		     ffetargetCharacterSize size);
-void ffeinfo_set_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype,
-		       ffetype type);
-ffetype ffeinfo_type (ffeinfoBasictype basictype, ffeinfoKindtype kindtype);
-
-/* Define macros. */
-
-#define ffeinfo_basictype(i) (i.basictype)
-#define ffeinfo_init_1()
-#define ffeinfo_init_2()
-#define ffeinfo_init_3()
-#define ffeinfo_init_4()
-#define ffeinfo_kind(i) (i.kind)
-#define ffeinfo_kindtype(i) (i.kindtype)
-#ifdef __GNUC__
-#define ffeinfo_new(bt,kt,r,k,w,sz) \
-  ((ffeinfo) {(bt), (kt), (r), (k), (w), (sz)})
-#endif
-#define ffeinfo_new_any()						      \
-  ffeinfo_new (FFEINFO_basictypeANY, FFEINFO_kindtypeANY, 0,		      \
-	       FFEINFO_kindANY, FFEINFO_whereANY,			      \
-	       FFETARGET_charactersizeNONE)
-#define ffeinfo_new_null()						      \
-  ffeinfo_new (FFEINFO_basictypeNONE, FFEINFO_kindtypeNONE, 0,		      \
-	       FFEINFO_kindNONE, FFEINFO_whereNONE,			      \
-	       FFETARGET_charactersizeNONE)
-#define ffeinfo_rank(i) (i.rank)
-#define ffeinfo_size(i) (i.size)
-#define ffeinfo_terminate_0()
-#define ffeinfo_terminate_1()
-#define ffeinfo_terminate_2()
-#define ffeinfo_terminate_3()
-#define ffeinfo_terminate_4()
-#define ffeinfo_use(i) i
-#define ffeinfo_where(i) (i.where)
-
-#define FFEINFO_kindtypeINTEGERDEFAULT FFEINFO_kindtypeINTEGER1
-#define FFEINFO_kindtypeLOGICALDEFAULT FFEINFO_kindtypeLOGICAL1
-#define FFEINFO_kindtypeREALDEFAULT FFEINFO_kindtypeREAL1
-#define FFEINFO_kindtypeREALDOUBLE FFEINFO_kindtypeREAL2
-#define FFEINFO_kindtypeREALQUAD FFEINFO_kindtypeREAL3
-#define FFEINFO_kindtypeCHARACTERDEFAULT FFEINFO_kindtypeCHARACTER1
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_INFO_H */
diff --git a/gcc/f/intdoc.c b/gcc/f/intdoc.c
deleted file mode 100644
index b24c79a..0000000
--- a/gcc/f/intdoc.c
+++ /dev/null
@@ -1,1325 +0,0 @@
-/* intdoc.c
-   Copyright (C) 1997, 2000, 2001, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.  */
-
-/* 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 "bconfig.h"
-#include "system.h"
-#include "coretypes.h"
-#include "tm.h"
-#include "assert.h"
-
-/* Pull in the intrinsics info, but only the doc parts.  */
-#define FFEINTRIN_DOC 1
-#include "intrin.h"
-
-const char *family_name (ffeintrinFamily family);
-static void dumpif (ffeintrinFamily fam);
-static void dumpendif (void);
-static void dumpclearif (void);
-static void dumpem (void);
-static void dumpgen (int menu, const char *name, const char *name_uc,
-		     ffeintrinGen gen);
-static void dumpspec (int menu, const char *name, const char *name_uc,
-		      ffeintrinSpec spec);
-static void dumpimp (int menu, const char *name, const char *name_uc, size_t genno, ffeintrinFamily family,
-		     ffeintrinImp imp, ffeintrinSpec spec);
-static const char *argument_info_ptr (ffeintrinImp imp, int argno);
-static const char *argument_info_string (ffeintrinImp imp, int argno);
-static const char *argument_name_ptr (ffeintrinImp imp, int argno);
-static const char *argument_name_string (ffeintrinImp imp, int argno);
-#if 0
-static const char *elaborate_if_complex (ffeintrinImp imp, int argno);
-static const char *elaborate_if_maybe_complex (ffeintrinImp imp, int argno);
-static const char *elaborate_if_real (ffeintrinImp imp, int argno);
-#endif
-static void print_type_string (const char *c);
-
-int
-main (int argc, char **argv ATTRIBUTE_UNUSED)
-{
-  if (argc != 1)
-    {
-      fprintf (stderr, "\
-Usage: intdoc > intdoc.texi\n\
-  Collects and dumps documentation on g77 intrinsics\n\
-  to the file named intdoc.texi.\n");
-      exit (1);
-    }
-
-  dumpem ();
-  return 0;
-}
-
-struct _ffeintrin_name_
-  {
-    const char *const name_uc;
-    const char *const name_lc;
-    const char *const name_ic;
-    const ffeintrinGen generic;
-    const ffeintrinSpec specific;
-  };
-
-struct _ffeintrin_gen_
-  {
-    const char *const name;		/* Name as seen in program. */
-    const ffeintrinSpec specs[2];
-  };
-
-struct _ffeintrin_spec_
-  {
-    const char *const name;	/* Uppercase name as seen in source code,
-				   lowercase if no source name, "none" if no
-				   name at all (NONE case). */
-    const bool is_actualarg;	/* Ok to pass as actual arg if -pedantic. */
-    const ffeintrinFamily family;
-    const ffeintrinImp implementation;
-  };
-
-struct _ffeintrin_imp_
-  {
-    const char *const name;		/* Name of implementation. */
-    const char *const control;
-  };
-
-static const struct _ffeintrin_name_ names[] = {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
-  { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-static const struct _ffeintrin_gen_ gens[] = {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
-  { NAME, { SPEC1, SPEC2, }, },
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-static const struct _ffeintrin_imp_ imps[] = {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
-  { NAME, CONTROL },
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
-  { NAME, CONTROL },
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-static const struct _ffeintrin_spec_ specs[] = {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
-  { NAME, CALLABLE, FAMILY, IMP, },
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-struct cc_pair { const ffeintrinImp imp; const char *const text; };
-
-static const char *descriptions[FFEINTRIN_imp] = { 0 };
-static const struct cc_pair cc_descriptions[] = {
-#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, DESCRIPTION },
-#include "intdoc.h0"
-#undef DEFDOC
-};
-
-static const char *summaries[FFEINTRIN_imp] = { 0 };
-static const struct cc_pair cc_summaries[] = {
-#define DEFDOC(IMP,SUMMARY,DESCRIPTION) { FFEINTRIN_imp ## IMP, SUMMARY },
-#include "intdoc.h0"
-#undef DEFDOC
-};
-
-const char *
-family_name (ffeintrinFamily family)
-{
-  switch (family)
-    {
-    case FFEINTRIN_familyF77:
-      return "familyF77";
-
-    case FFEINTRIN_familyASC:
-      return "familyASC";
-
-    case FFEINTRIN_familyMIL:
-      return "familyMIL";
-
-    case FFEINTRIN_familyGNU:
-      return "familyGNU";
-
-    case FFEINTRIN_familyF90:
-      return "familyF90";
-
-    case FFEINTRIN_familyVXT:
-      return "familyVXT";
-
-    case FFEINTRIN_familyFVZ:
-      return "familyFVZ";
-
-    case FFEINTRIN_familyF2C:
-      return "familyF2C";
-
-    case FFEINTRIN_familyF2U:
-      return "familyF2U";
-
-    case FFEINTRIN_familyBADU77:
-      return "familyBADU77";
-
-    default:
-      assert ("bad family" == NULL);
-      return "??";
-    }
-}
-
-static int in_ifset = 0;
-static ffeintrinFamily latest_family = FFEINTRIN_familyNONE;
-
-static void
-dumpif (ffeintrinFamily fam)
-{
-  assert (fam != FFEINTRIN_familyNONE);
-  if ((in_ifset != 2)
-      || (fam != latest_family))
-    {
-      if (in_ifset == 2)
-	printf ("@end ifset\n");
-      latest_family = fam;
-      printf ("@ifset %s\n", family_name (fam));
-    }
-  in_ifset = 1;
-}
-
-static void
-dumpendif (void)
-{
-  in_ifset = 2;
-}
-
-static void
-dumpclearif (void)
-{
-  if ((in_ifset == 2)
-      || (latest_family != FFEINTRIN_familyNONE))
-    printf ("@end ifset\n");
-  latest_family = FFEINTRIN_familyNONE;
-  in_ifset = 0;
-}
-
-static void
-dumpem (void)
-{
-  int i;
-
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_descriptions); ++i)
-    {
-      assert (descriptions[cc_descriptions[i].imp] == NULL);
-      descriptions[cc_descriptions[i].imp] = cc_descriptions[i].text;
-    }
-
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (cc_summaries); ++i)
-    {
-      assert (summaries[cc_summaries[i].imp] == NULL);
-      summaries[cc_summaries[i].imp] = cc_summaries[i].text;
-    }
-
-  printf ("@c This file is automatically derived from intdoc.c, intdoc.in,\n");
-  printf ("@c ansify.c, intrin.def, and intrin.h.  Edit those files instead.\n");
-  printf ("@menu\n");
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
-    {
-      if (names[i].generic != FFEINTRIN_genNONE)
-	dumpgen (1, names[i].name_ic, names[i].name_uc,
-		 names[i].generic);
-      if (names[i].specific != FFEINTRIN_specNONE)
-	dumpspec (1, names[i].name_ic, names[i].name_uc,
-		  names[i].specific);
-    }
-  dumpclearif ();
-
-  printf ("@end menu\n\n");
-
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (names); ++i)
-    {
-      if (names[i].generic != FFEINTRIN_genNONE)
-	dumpgen (0, names[i].name_ic, names[i].name_uc,
-		 names[i].generic);
-      if (names[i].specific != FFEINTRIN_specNONE)
-	dumpspec (0, names[i].name_ic, names[i].name_uc,
-		  names[i].specific);
-    }
-  dumpclearif ();
-}
-
-static void
-dumpgen (int menu, const char *name, const char *name_uc, ffeintrinGen gen)
-{
-  size_t i;
-  int total = 0;
-
-  if (!menu)
-    {
-      for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
-	{
-	  if (gens[gen].specs[i] != FFEINTRIN_specNONE)
-	    ++total;
-	}
-    }
-
-  for (i = 0; i < ARRAY_SIZE (gens[gen].specs); ++i)
-    {
-      ffeintrinSpec spec;
-      size_t j;
-
-      if ((spec = gens[gen].specs[i]) == FFEINTRIN_specNONE)
-	continue;
-
-      dumpif (specs[spec].family);
-      dumpimp (menu, name, name_uc, i, specs[spec].family, specs[spec].implementation,
-	       spec);
-      if (!menu && (total > 0))
-	{
-	  if (total == 1)
-	    {
-	      printf ("\
-For information on another intrinsic with the same name:\n");
-	    }
-	  else
-	    {
-	      printf ("\
-For information on other intrinsics with the same name:\n");
-	    }
-	  for (j = 0; j < ARRAY_SIZE (gens[gen].specs); ++j)
-	    {
-	      if (j == i)
-		continue;
-	      if ((spec = gens[gen].specs[j]) == FFEINTRIN_specNONE)
-		continue;
-	      printf ("@xref{%s Intrinsic (%s)}.\n",
-		      name, specs[spec].name);
-	    }
-	  printf ("\n");
-	}
-      dumpendif ();
-    }
-}
-
-static void
-dumpspec (int menu, const char *name, const char *name_uc, ffeintrinSpec spec)
-{
-  dumpif (specs[spec].family);
-  dumpimp (menu, name, name_uc, 0, specs[spec].family, specs[spec].implementation,
-	   FFEINTRIN_specNONE);
-  dumpendif ();
-}
-
-static void
-dumpimp (int menu, const char *name, const char *name_uc, size_t genno,
-	 ffeintrinFamily family, ffeintrinImp imp, ffeintrinSpec spec)
-{
-  const char *c;
-  bool subr;
-  const char *argc;
-  const char *argi;
-  int colon;
-  int argno;
-
-  assert ((imp != FFEINTRIN_impNONE) || !genno);
-
-  if (menu)
-    {
-      printf ("* %s Intrinsic",
-	      name);
-      if (spec != FFEINTRIN_specNONE)
-	printf (" (%s)", specs[spec].name);	/* See XYZZY1 below */
-      printf ("::");
-#define INDENT_SUMMARY 24
-      if ((imp == FFEINTRIN_impNONE)
-	  || (summaries[imp] != NULL))
-	{
-	  int spaces = INDENT_SUMMARY - 14 - strlen (name);
-	  const char *c;
-
-	  if (spec != FFEINTRIN_specNONE)
-	    spaces -= (3 + strlen (specs[spec].name));	/* See XYZZY1 above */
-	  if (spaces < 1)
-	    spaces = 1;
-	  while (spaces--)
-	    fputc (' ', stdout);
-
-	  if (imp == FFEINTRIN_impNONE)
-	    {
-	      printf ("(Reserved for future use.)\n");
-	      return;
-	    }
-
-	  for (c = summaries[imp]; c[0] != '\0'; ++c)
-	    {
-	      if (c[0] == '@' && ISDIGIT (c[1]))
-		{
-		  int argno = c[1] - '0';
-
-		  c += 2;
-		  while (ISDIGIT (c[0]))
-		    {
-		      argno = 10 * argno + (c[0] - '0');
-		      ++c;
-		    }
-		  assert (c[0] == '@');
-		  if (argno == 0)
-		    printf ("%s", name);
-		  else if (argno == 99)
-		    {	/* Yeah, this is a major kludge. */
-		      printf ("\n");
-		      spaces = INDENT_SUMMARY + 1;
-		      while (spaces--)
-			fputc (' ', stdout);
-		    }
-		  else
-		    printf ("%s", argument_name_string (imp, argno - 1));
-		}
-	      else
-		fputc (c[0], stdout);
-	    }
-	}
-      printf ("\n");
-      return;
-    }
-
-  printf ("@node %s Intrinsic", name);
-  if (spec != FFEINTRIN_specNONE)
-    printf (" (%s)", specs[spec].name);
-  printf ("\n@subsubsection %s Intrinsic", name);
-  if (spec != FFEINTRIN_specNONE)
-    printf (" (%s)", specs[spec].name);
-  printf ("\n@cindex %s intrinsic\n@cindex intrinsics, %s\n",
-	  name, name);
-
-  if (imp == FFEINTRIN_impNONE)
-    {
-      printf ("\n\
-This intrinsic is not yet implemented.\n\
-The name is, however, reserved as an intrinsic.\n\
-Use @samp{EXTERNAL %s} to use this name for an\n\
-external procedure.\n\
-\n\
-",
-	      name);
-      return;
-    }
-
-  c = imps[imp].control;
-  subr = (c[0] == '-');
-  colon = (c[2] == ':') ? 2 : 3;
-
-  printf ("\n\
-@noindent\n\
-@example\n\
-%s%s(",
-	  (subr ? "CALL " : ""), name);
-
-  fflush (stdout);
-
-  for (argno = 0; ; ++argno)
-    {
-      argc = argument_name_ptr (imp, argno);
-      if (argc == NULL)
-	break;
-      if (argno > 0)
-	printf (", ");
-      printf ("@var{%s}", argc);
-      argi = argument_info_string (imp, argno);
-      if ((argi[0] == '*')
-	  || (argi[0] == 'n')
-	  || (argi[0] == '+')
-	  || (argi[0] == 'p'))
-	printf ("-1, @var{%s}-2, @dots{}, @var{%s}-n",
-		argc, argc);
-    }
-
-  printf (")\n\
-@end example\n\
-\n\
-");
-
-  if (!subr)
-    {
-      int other_arg;
-      const char *arg_string;
-      const char *arg_info;
-
-      if (ISDIGIT (c[colon + 1]))
-	{
-	  other_arg = c[colon + 1] - '0';
-	  arg_string = argument_name_string (imp, other_arg);
-	  arg_info = argument_info_string (imp, other_arg);
-	}
-      else
-	{
-	  other_arg = -1;
-	  arg_string = NULL;
-	  arg_info = NULL;
-	}
-
-      printf ("\
-@noindent\n\
-%s: ", name);
-      print_type_string (c);
-      printf (" function");
-
-      if ((c[0] == 'R')
-	  && (c[1] == 'C'))
-	{
-	  assert (other_arg >= 0);
-
-	  if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
-	  || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
-	    ++arg_info;
-	  if ((arg_info[0] == 'F') || (arg_info[0] == 'N'))
-	    printf (".\n\
-The exact type is @samp{REAL(KIND=1)} when argument @var{%s} is\n\
-any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.\n\
-When @var{%s} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},\n\
-this intrinsic is valid only when used as the argument to\n\
-@code{REAL()}, as explained below.\n\n",
-		    arg_string,
-		    arg_string);
-	  else
-	    printf (".\n\
-This intrinsic is valid when argument @var{%s} is\n\
-@code{COMPLEX(KIND=1)}.\n\
-When @var{%s} is any other @code{COMPLEX} type,\n\
-this intrinsic is valid only when used as the argument to\n\
-@code{REAL()}, as explained below.\n\n",
-		    arg_string,
-		    arg_string);
-	}
-#if 0
-      else if ((c[0] == 'I')
-	       && (c[1] == '7'))
-	printf (", the exact type being wide enough to hold a pointer\n\
-on the target system (typically @code{INTEGER(KIND=1)} or @code{INTEGER(KIND=4)}).\n\n");
-#endif
-      else if (c[1] == '=' && ISDIGIT (c[colon + 1]))
-	{
-	  assert (other_arg >= 0);
-
-	  if ((arg_info[0] == '?') || (arg_info[0] == '!') || (arg_info[0] == '+')
-	  || (arg_info[0] == '*') || (arg_info[0] == 'n') || (arg_info[0] == 'p'))
-	    ++arg_info;
-
-	  if (((c[0] == arg_info[0])
-	       && ((c[0] == 'A') || (c[0] == 'C') || (c[0] == 'I')
-		   || (c[0] == 'L') || (c[0] == 'R')))
-	      || ((c[0] == 'R')
-		  && (arg_info[0] == 'C'))
-	      || ((c[0] == 'C')
-		  && (arg_info[0] == 'R')))
-	    printf (", the @samp{KIND=} value of the type being that of argument @var{%s}.\n\n",
-		    arg_string);
-	  else if ((c[0] == 'S')
-		   && ((arg_info[0] == 'C')
-		       || (arg_info[0] == 'F')
-		       || (arg_info[0] == 'N')))
-	    printf (".\n\
-The exact type depends on that of argument @var{%s}---if @var{%s} is\n\
-@code{COMPLEX}, this function's type is @code{REAL}\n\
-with the same @samp{KIND=} value as the type of @var{%s}.\n\
-Otherwise, this function's type is the same as that of @var{%s}.\n\n",
-		    arg_string, arg_string, arg_string, arg_string);
-	  else
-	    printf (", the exact type being that of argument @var{%s}.\n\n",
-		    arg_string);
-	}
-      else if ((c[1] == '=')
-	       && (c[colon + 1] == '*'))
-	printf (", the exact type being the result of cross-promoting the\n\
-types of all the arguments.\n\n");
-      else if (c[1] == '=')
-	assert ("?0:?:" == NULL);
-      else
-	printf (".\n\n");
-    }
-
-  for (argno = 0, argc = &c[colon + 3]; *argc != '\0'; ++argno)
-    {
-      char optionality = '\0';
-      char extra = '\0';
-      char basic;
-      char kind;
-      int length;
-      int elements;
-
-      printf ("\
-@noindent\n\
-@var{");
-      for (; ; ++argc)
-	{
-	  if (argc[0] == '=')
-	    break;
-	  printf ("%c", *argc);
-	}
-      printf ("}: ");
-
-      ++argc;
-      if ((*argc == '?')
-	  || (*argc == '!')
-	  || (*argc == '*')
-	  || (*argc == '+')
-	  || (*argc == 'n')
-	  || (*argc == 'p'))
-	optionality = *(argc++);
-      basic = *(argc++);
-      kind = *(argc++);
-      if (*argc == '[')
-	{
-	  length = *++argc - '0';
-	  if (*++argc != ']')
-	    length = 10 * length + (*(argc++) - '0');
-	  ++argc;
-	}
-      else
-	length = -1;
-      if (*argc == '(')
-	{
-	  elements = *++argc - '0';
-	  if (*++argc != ')')
-	    elements = 10 * elements + (*(argc++) - '0');
-	  ++argc;
-	}
-      else if (*argc == '&')
-	{
-	  elements = -1;
-	  ++argc;
-	}
-      else
-	elements = 0;
-      if ((*argc == '&')
-	  || (*argc == 'i')
-	  || (*argc == 'w')
-	  || (*argc == 'x'))
-	extra = *(argc++);
-      if (*argc == ',')
-	++argc;
-
-      switch (basic)
-	{
-	case '-':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("Any type");
-	      break;
-
-	    default:
-	      assert ("kind arg" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'A':
-	  assert ((kind == '1') || (kind == '*'));
-	  printf ("@code{CHARACTER");
-	  if (length != -1)
-	    printf ("*%d", length);
-	  printf ("}");
-	  break;
-
-	case 'C':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{COMPLEX}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("Same @samp{KIND=} value as for @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    default:
-	      assert ("Ca" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'I':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{INTEGER}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("@code{INTEGER} with same @samp{KIND=} value as for @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    case 'N':
-	      printf ("@code{INTEGER} not wider than the default kind");
-	      break;
-
-	    default:
-	      assert ("Ia" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'L':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{LOGICAL}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("@code{LOGICAL} with same @samp{KIND=} value as for @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    case 'N':
-	      printf ("@code{LOGICAL} not wider than the default kind");
-	      break;
-
-	    default:
-	      assert ("La" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'R':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{REAL}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{REAL(KIND=%d)}", (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("@code{REAL} with same @samp{KIND=} value as for @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    default:
-	      assert ("Ra" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'B':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{INTEGER} or @code{LOGICAL}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
-		      (kind - '0'), (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("Same type and @samp{KIND=} value as for @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    case 'N':
-	      printf ("@code{INTEGER} or @code{LOGICAL} not wider than the default kind");
-	      break;
-
-	    default:
-	      assert ("Ba" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'F':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{REAL} or @code{COMPLEX}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
-		      (kind - '0'), (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("Same type as @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    default:
-	      assert ("Fa" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'N':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
-		      (kind - '0'), (kind - '0'), (kind - '0'));
-	      break;
-
-	    default:
-	      assert ("N1" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'S':
-	  switch (kind)
-	    {
-	    case '*':
-	      printf ("@code{INTEGER} or @code{REAL}");
-	      break;
-
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
-		      (kind - '0'), (kind - '0'));
-	      break;
-
-	    case 'A':
-	      printf ("@code{INTEGER} or @code{REAL} with same @samp{KIND=} value as for @var{%s}",
-		      argument_name_string (imp, 0));
-	      break;
-
-	    default:
-	      assert ("Sa" == NULL);
-	      break;
-	    }
-	  break;
-
-	case 'g':
-	  printf ("@samp{*@var{label}}, where @var{label} is the label\n\
-of an executable statement");
-	  break;
-
-	case 's':
-	  printf ("Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})\n\
-or dummy/global @code{INTEGER(KIND=1)} scalar");
-	  break;
-
-	default:
-	  assert ("arg type?" == NULL);
-	  break;
-	}
-
-      switch (optionality)
-	{
-	case '\0':
-	  break;
-
-	case '!':
-	  printf ("; OPTIONAL (must be omitted if @var{%s} is @code{COMPLEX})",
-		  argument_name_string (imp, argno-1));
-	  break;
-
-	case '?':
-	  printf ("; OPTIONAL");
-	  break;
-
-	case '*':
-	  printf ("; OPTIONAL");
-	  break;
-
-	case 'n':
-	case '+':
-	  break;
-
-	case 'p':
-	  printf ("; at least two such arguments must be provided");
-	  break;
-
-	default:
-	  assert ("optionality!" == NULL);
-	  break;
-	}
-
-      switch (elements)
-	{
-	case -1:
-	  break;
-
-	case 0:
-	  if ((basic != 'g')
-	      && (basic != 's'))
-	    printf ("; scalar");
-	  break;
-
-	default:
-	  assert (extra != '\0');
-	  printf ("; DIMENSION(%d)", elements);
-	  break;
-	}
-
-      switch (extra)
-	{
-	case '\0':
-	  if ((basic != 'g')
-	      && (basic != 's'))
-	    printf ("; INTENT(IN)");
-	  break;
-
-	case 'i':
-	  break;
-
-	case '&':
-	  printf ("; cannot be a constant or expression");
-	  break;
-
-	case 'w':
-	  printf ("; INTENT(OUT)");
-	  break;
-
-	case 'x':
-	  printf ("; INTENT(INOUT)");
-	  break;
-	}
-
-      printf (".\n\n");
-    }
-
-  printf ("\
-@noindent\n\
-Intrinsic groups: ");
-  switch (family)
-    {
-    case FFEINTRIN_familyF77:
-      printf ("(standard FORTRAN 77).");
-      break;
-
-    case FFEINTRIN_familyGNU:
-      printf ("@code{gnu}.");
-      break;
-
-    case FFEINTRIN_familyASC:
-      printf ("@code{f2c}, @code{f90}.");
-      break;
-
-    case FFEINTRIN_familyMIL:
-      printf ("@code{mil}, @code{f90}, @code{vxt}.");
-      break;
-
-    case FFEINTRIN_familyF90:
-      printf ("@code{f90}.");
-      break;
-
-    case FFEINTRIN_familyVXT:
-      printf ("@code{vxt}.");
-      break;
-
-    case FFEINTRIN_familyFVZ:
-      printf ("@code{f2c}, @code{vxt}.");
-      break;
-
-    case FFEINTRIN_familyF2C:
-      printf ("@code{f2c}.");
-      break;
-
-    case FFEINTRIN_familyF2U:
-      printf ("@code{unix}.");
-      break;
-
-    case FFEINTRIN_familyBADU77:
-      printf ("@code{badu77}.");
-      break;
-
-    default:
-      assert ("bad family" == NULL);
-      printf ("@code{???}.");
-      break;
-    }
-  printf ("\n\n");
-
-  if (descriptions[imp] != NULL)
-    {
-      const char *c = descriptions[imp];
-
-      printf ("\
-@noindent\n\
-Description:\n\
-\n");
-
-      while (c[0] != '\0')
-	{
-	  if (c[0] == '@' && ISDIGIT (c[1]))
-	    {
-	      int argno = c[1] - '0';
-
-	      c += 2;
-	      while (ISDIGIT (c[0]))
-		{
-		  argno = 10 * argno + (c[0] - '0');
-		  ++c;
-		}
-	      assert (c[0] == '@');
-	      if (argno == 0)
-		printf ("%s", name_uc);
-	      else
-		printf ("%s", argument_name_string (imp, argno - 1));
-	    }
-	  else
-	    fputc (c[0], stdout);
-	  ++c;
-	}
-
-      printf ("\n");
-    }
-}
-
-static const char *
-argument_info_ptr (ffeintrinImp imp, int argno)
-{
-  const char *c = imps[imp].control;
-  static char arginfos[8][32];
-  static int argx = 0;
-  int i;
-
-  if (c[2] == ':')
-    c += 5;
-  else
-    c += 6;
-
-  while (argno--)
-    {
-      while ((c[0] != ',') && (c[0] != '\0'))
-	++c;
-      if (c[0] != ',')
-	break;
-      ++c;
-    }
-
-  if (c[0] == '\0')
-    return NULL;
-
-  for (; (c[0] != '=') && (c[0] != '\0'); ++c)
-    ;
-
-  assert (c[0] == '=');
-
-  for (i = 0, ++c; (c[0] != ',') && (c[0] != '\0'); ++c, ++i)
-    arginfos[argx][i] = c[0];
-
-  arginfos[argx][i] = '\0';
-
-  c = &arginfos[argx][0];
-  ++argx;
-  if (((size_t) argx) >= ARRAY_SIZE (arginfos))
-    argx = 0;
-
-  return c;
-}
-
-static const char *
-argument_info_string (ffeintrinImp imp, int argno)
-{
-  const char *p;
-
-  p = argument_info_ptr (imp, argno);
-  assert (p != NULL);
-  return p;
-}
-
-static const char *
-argument_name_ptr (ffeintrinImp imp, int argno)
-{
-  const char *c = imps[imp].control;
-  static char argnames[8][32];
-  static int argx = 0;
-  int i;
-
-  if (c[2] == ':')
-    c += 5;
-  else
-    c += 6;
-
-  while (argno--)
-    {
-      while ((c[0] != ',') && (c[0] != '\0'))
-	++c;
-      if (c[0] != ',')
-	break;
-      ++c;
-    }
-
-  if (c[0] == '\0')
-    return NULL;
-
-  for (i = 0; (c[0] != '=') && (c[0] != '\0'); ++c, ++i)
-    argnames[argx][i] = c[0];
-
-  assert (c[0] == '=');
-  argnames[argx][i] = '\0';
-
-  c = &argnames[argx][0];
-  ++argx;
-  if (((size_t) argx) >= ARRAY_SIZE (argnames))
-    argx = 0;
-
-  return c;
-}
-
-static const char *
-argument_name_string (ffeintrinImp imp, int argno)
-{
-  const char *p;
-
-  p = argument_name_ptr (imp, argno);
-  assert (p != NULL);
-  return p;
-}
-
-static void
-print_type_string (const char *c)
-{
-  char basic = c[0];
-  char kind = c[1];
-
-  switch (basic)
-    {
-    case 'A':
-      assert ((kind == '1') || (kind == '='));
-      if (c[2] == ':')
-	printf ("@code{CHARACTER*1}");
-      else
-	{
-	  assert (c[2] == '*');
-	  printf ("@code{CHARACTER*(*)}");
-	}
-      break;
-
-    case 'C':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{COMPLEX}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{COMPLEX(KIND=%d)}", (kind - '0'));
-	  break;
-
-	default:
-	  assert ("Ca" == NULL);
-	  break;
-	}
-      break;
-
-    case 'I':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{INTEGER}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{INTEGER(KIND=%d)}", (kind - '0'));
-	  break;
-
-	default:
-	  assert ("Ia" == NULL);
-	  break;
-	}
-      break;
-
-    case 'L':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{LOGICAL}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{LOGICAL(KIND=%d)}", (kind - '0'));
-	  break;
-
-	default:
-	  assert ("La" == NULL);
-	  break;
-	}
-      break;
-
-    case 'R':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{REAL}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{REAL(KIND=%d)}", (kind - '0'));
-	  break;
-
-	case 'C':
-	  printf ("@code{REAL}");
-	  break;
-
-	default:
-	  assert ("Ra" == NULL);
-	  break;
-	}
-      break;
-
-    case 'B':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{INTEGER} or @code{LOGICAL}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{INTEGER(KIND=%d)} or @code{LOGICAL(KIND=%d)}",
-		  (kind - '0'), (kind - '0'));
-	  break;
-
-	default:
-	  assert ("Ba" == NULL);
-	  break;
-	}
-      break;
-
-    case 'F':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{REAL} or @code{COMPLEX}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{REAL(KIND=%d)} or @code{COMPLEX(KIND=%d)}",
-		  (kind - '0'), (kind - '0'));
-	  break;
-
-	default:
-	  assert ("Fa" == NULL);
-	  break;
-	}
-      break;
-
-    case 'N':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{INTEGER}, @code{REAL}, or @code{COMPLEX}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{INTEGER(KIND=%d)}, @code{REAL(KIND=%d)}, or @code{COMPLEX(KIND=%d)}",
-		  (kind - '0'), (kind - '0'), (kind - '0'));
-	  break;
-
-	default:
-	  assert ("N1" == NULL);
-	  break;
-	}
-      break;
-
-    case 'S':
-      switch (kind)
-	{
-	case '=':
-	  printf ("@code{INTEGER} or @code{REAL}");
-	  break;
-
-	case '1': case '2': case '3': case '4': case '5':
-	case '6': case '7': case '8': case '9':
-	  printf ("@code{INTEGER(KIND=%d)} or @code{REAL(KIND=%d)}",
-		  (kind - '0'), (kind - '0'));
-	  break;
-
-	default:
-	  assert ("Sa" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("type?" == NULL);
-      break;
-    }
-}
diff --git a/gcc/f/intdoc.in b/gcc/f/intdoc.in
deleted file mode 100644
index 6f2423f..0000000
--- a/gcc/f/intdoc.in
+++ /dev/null
@@ -1,2705 +0,0 @@
-/* Copyright (C) 1997, 1999, 2003 Free Software Foundation, Inc.
- * This is part of the G77 manual.
- * For copying conditions, see the file g77.texi. */
-
-/* This is the file containing the verbage for the
-   intrinsics.  It consists of a data base built up
-   via DEFDOC macros of the form:
-
-   DEFDOC (IMP, SUMMARY, DESCRIPTION)
-
-   IMP is the implementation keyword used in the intrin module.
-   SUMMARY is the short summary to go in the "* Menu:" section
-   of the Info document.  DESCRIPTION is the longer description
-   to go in the documentation itself.
-
-   Note that IMP is leveraged across multiple intrinsic names.
-
-   To make for more accurate and consistent documentation,
-   the translation made by intdoc.c of the text in SUMMARY
-   and DESCRIPTION includes the special sequence
-
-   @ARGNO@
-
-   where ARGNO is a series of digits forming a number that
-   is substituted by intdoc.c as follows:
-
-   0     The initial-caps form of the intrinsic name (e.g. Float).
-   1-98  The initial-caps form of the ARGNO'th argument.
-   99    (SUMMARY only) a newline plus the appropriate # of spaces.
-
-   Hope this info is enough to encourage people to feel free to
-   add documentation to this file!
-
-*/
-
-#define ARCHAIC(upper,mixed) \
-  "Archaic form of @code{" #upper "()} that is specific\n\
-to one type for @var{@1@}.\n\
-@xref{" #mixed " Intrinsic}.\n"
-
-#define ARCHAIC_2nd(upper,mixed) \
-  "Archaic form of @code{" #upper "()} that is specific\n\
-to one type for @var{@2@}.\n\
-@xref{" #mixed " Intrinsic}.\n"
-
-#define ARCHAIC_2(upper,mixed) \
-  "Archaic form of @code{" #upper "()} that is specific\n\
-to one type for @var{@1@} and @var{@2@}.\n\
-@xref{" #mixed " Intrinsic}.\n"
-
-DEFDOC (ABS, "Absolute value.", "\
-Returns the absolute value of @var{@1@}.
-
-If @var{@1@} is type @code{COMPLEX}, the absolute
-value is computed as:
-
-@example
-SQRT(REALPART(@var{@1@})**2+IMAGPART(@var{@1@})**2)
-@end example
-
-@noindent
-Otherwise, it is computed by negating @var{@1@} if
-it is negative, or returning @var{@1@}.
-
-@xref{Sign Intrinsic}, for how to explicitly
-compute the positive or negative form of the absolute
-value of an expression.
-")
-
-DEFDOC (CABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
-
-DEFDOC (DABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
-
-DEFDOC (IABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
-
-DEFDOC (CDABS, "Absolute value (archaic).", ARCHAIC (ABS, Abs))
-
-DEFDOC (ACHAR, "ASCII character from code.", "\
-Returns the ASCII character corresponding to the
-code specified by @var{@1@}.
-
-@xref{IAChar Intrinsic}, for the inverse of this function.
-
-@xref{Char Intrinsic}, for the function corresponding
-to the system's native character set.
-")
-
-DEFDOC (IACHAR, "ASCII code for character.", "\
-Returns the code for the ASCII character in the
-first character position of @var{@1@}.
-
-@xref{AChar Intrinsic}, for the inverse of this function.
-
-@xref{IChar Intrinsic}, for the function corresponding
-to the system's native character set.
-")
-
-DEFDOC (CHAR, "Character from code.", "\
-Returns the character corresponding to the
-code specified by @var{@1@}, using the system's
-native character set.
-
-Because the system's native character set is used,
-the correspondence between character and their codes
-is not necessarily the same between GNU Fortran
-implementations.
-
-Note that no intrinsic exists to convert a numerical
-value to a printable character string.
-For example, there is no intrinsic that, given
-an @code{INTEGER} or @code{REAL} argument with the
-value @samp{154}, returns the @code{CHARACTER}
-result @samp{'154'}.
-
-Instead, you can use internal-file I/O to do this kind
-of conversion.
-For example:
-
-@smallexample
-INTEGER VALUE
-CHARACTER*10 STRING
-VALUE = 154
-WRITE (STRING, '(I10)'), VALUE
-PRINT *, STRING
-END
-@end smallexample
-
-The above program, when run, prints:
-
-@smallexample
-        154
-@end smallexample
-
-@xref{IChar Intrinsic}, for the inverse of the @code{@0@} function.
-
-@xref{AChar Intrinsic}, for the function corresponding
-to the ASCII character set.
-")
-
-DEFDOC (ICHAR, "Code for character.", "\
-Returns the code for the character in the
-first character position of @var{@1@}.
-
-Because the system's native character set is used,
-the correspondence between character and their codes
-is not necessarily the same between GNU Fortran
-implementations.
-
-Note that no intrinsic exists to convert a printable
-character string to a numerical value.
-For example, there is no intrinsic that, given
-the @code{CHARACTER} value @samp{'154'}, returns an
-@code{INTEGER} or @code{REAL} value with the value @samp{154}.
-
-Instead, you can use internal-file I/O to do this kind
-of conversion.
-For example:
-
-@smallexample
-INTEGER VALUE
-CHARACTER*10 STRING
-STRING = '154'
-READ (STRING, '(I10)'), VALUE
-PRINT *, VALUE
-END
-@end smallexample
-
-The above program, when run, prints:
-
-@smallexample
- 154
-@end smallexample
-
-@xref{Char Intrinsic}, for the inverse of the @code{@0@} function.
-
-@xref{IAChar Intrinsic}, for the function corresponding
-to the ASCII character set.
-")
-
-DEFDOC (ACOS, "Arc cosine.", "\
-Returns the arc-cosine (inverse cosine) of @var{@1@}
-in radians.
-
-@xref{Cos Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (DACOS, "Arc cosine (archaic).", ARCHAIC (ACOS, ACos))
-
-DEFDOC (AIMAG, "Convert/extract imaginary part of complex.", "\
-Returns the (possibly converted) imaginary part of @var{@1@}.
-
-Use of @code{@0@()} with an argument of a type
-other than @code{COMPLEX(KIND=1)} is restricted to the following case:
-
-@example
-REAL(AIMAG(@1@))
-@end example
-
-@noindent
-This expression converts the imaginary part of @1@ to
-@code{REAL(KIND=1)}.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-")
-
-DEFDOC (DIMAG, "Convert/extract imaginary part of complex (archaic).", ARCHAIC (AIMAG, AImag))
-
-DEFDOC (AINT, "Truncate to whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude truncated and its sign preserved.
-(Also called ``truncation towards zero''.)
-
-@xref{ANInt Intrinsic}, for how to round to nearest
-whole number.
-
-@xref{Int Intrinsic}, for how to truncate and then convert
-number to @code{INTEGER}.
-")
-
-DEFDOC (DINT, "Truncate to whole number (archaic).", ARCHAIC (AINT, AInt))
-
-DEFDOC (INT, "Convert to @code{INTEGER} value truncated@99@to whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=1)}.
-
-If @var{@1@} is type @code{COMPLEX}, its real part is
-truncated and converted, and its imaginary part is disregarded.
-
-@xref{NInt Intrinsic}, for how to convert, rounded to nearest
-whole number.
-
-@xref{AInt Intrinsic}, for how to truncate to whole number
-without converting.
-")
-
-DEFDOC (IDINT, "Convert to @code{INTEGER} value truncated@99@to whole number (archaic).", ARCHAIC (INT, Int))
-
-DEFDOC (ANINT, "Round to nearest whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude eliminated by rounding to the nearest whole
-number and with its sign preserved.
-
-A fractional portion exactly equal to
-@samp{.5} is rounded to the whole number that
-is larger in magnitude.
-(Also called ``Fortran round''.)
-
-@xref{AInt Intrinsic}, for how to truncate to
-whole number.
-
-@xref{NInt Intrinsic}, for how to round and then convert
-number to @code{INTEGER}.
-")
-
-DEFDOC (DNINT, "Round to nearest whole number (archaic).", ARCHAIC (ANINT, ANInt))
-
-DEFDOC (NINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude eliminated by rounding to the nearest whole
-number and with its sign preserved, converted
-to type @code{INTEGER(KIND=1)}.
-
-If @var{@1@} is type @code{COMPLEX}, its real part is
-rounded and converted.
-
-A fractional portion exactly equal to
-@samp{.5} is rounded to the whole number that
-is larger in magnitude.
-(Also called ``Fortran round''.)
-
-@xref{Int Intrinsic}, for how to convert, truncate to
-whole number.
-
-@xref{ANInt Intrinsic}, for how to round to nearest whole number
-without converting.
-")
-
-DEFDOC (IDNINT, "Convert to @code{INTEGER} value rounded@99@to nearest whole number (archaic).", ARCHAIC (NINT, NInt))
-
-DEFDOC (LOG, "Natural logarithm.", "\
-Returns the natural logarithm of @var{@1@}, which must
-be greater than zero or, if type @code{COMPLEX}, must not
-be zero.
-
-@xref{Exp Intrinsic}, for the inverse of this function.
-
-@xref{Log10 Intrinsic}, for the `common' (base-10) logarithm function.
-")
-
-DEFDOC (ALOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
-
-DEFDOC (CLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
-
-DEFDOC (DLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
-
-DEFDOC (CDLOG, "Natural logarithm (archaic).", ARCHAIC (LOG, Log))
-
-DEFDOC (LOG10, "Common logarithm.", "\
-Returns the common logarithm (base 10) of @var{@1@}, which must
-be greater than zero.
-
-The inverse of this function is @samp{10. ** LOG10(@var{@1@})}.
-
-@xref{Log Intrinsic}, for the natural logarithm function.
-")
-
-DEFDOC (ALOG10, "Common logarithm (archaic).", ARCHAIC (LOG10, Log10))
-
-DEFDOC (DLOG10, "Common logarithm (archaic).", ARCHAIC (LOG10, Log10))
-
-DEFDOC (MAX, "Maximum value.", "\
-Returns the argument with the largest value.
-
-@xref{Min Intrinsic}, for the opposite function.
-")
-
-DEFDOC (AMAX0, "Maximum value (archaic).", "\
-Archaic form of @code{MAX()} that is specific
-to one type for @var{@1@} and a different return type.
-@xref{Max Intrinsic}.
-")
-
-DEFDOC (AMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max))
-
-DEFDOC (DMAX1, "Maximum value (archaic).", ARCHAIC (MAX, Max))
-
-DEFDOC (MAX0, "Maximum value (archaic).", ARCHAIC (MAX, Max))
-
-DEFDOC (MAX1, "Maximum value (archaic).", "\
-Archaic form of @code{MAX()} that is specific
-to one type for @var{@1@} and a different return type.
-@xref{Max Intrinsic}.
-")
-
-DEFDOC (MIN, "Minimum value.", "\
-Returns the argument with the smallest value.
-
-@xref{Max Intrinsic}, for the opposite function.
-")
-
-DEFDOC (AMIN0, "Minimum value (archaic).", "\
-Archaic form of @code{MIN()} that is specific
-to one type for @var{@1@} and a different return type.
-@xref{Min Intrinsic}.
-")
-
-DEFDOC (AMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min))
-
-DEFDOC (DMIN1, "Minimum value (archaic).", ARCHAIC (MIN, Min))
-
-DEFDOC (MIN0, "Minimum value (archaic).", ARCHAIC (MIN, Min))
-
-DEFDOC (MIN1, "Minimum value (archaic).", "\
-Archaic form of @code{MIN()} that is specific
-to one type for @var{@1@} and a different return type.
-@xref{Min Intrinsic}.
-")
-
-DEFDOC (MOD, "Remainder.", "\
-Returns remainder calculated as:
-
-@smallexample
-@var{@1@} - (INT(@var{@1@} / @var{@2@}) * @var{@2@})
-@end smallexample
-
-@var{@2@} must not be zero.
-")
-
-DEFDOC (AMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod))
-
-DEFDOC (DMOD, "Remainder (archaic).", ARCHAIC (MOD, Mod))
-
-DEFDOC (AND, "Boolean AND.", "\
-Returns value resulting from boolean AND of
-pair of bits in each of @var{@1@} and @var{@2@}.
-")
-
-DEFDOC (IAND, "Boolean AND.", "\
-Returns value resulting from boolean AND of
-pair of bits in each of @var{@1@} and @var{@2@}.
-")
-
-DEFDOC (OR, "Boolean OR.", "\
-Returns value resulting from boolean OR of
-pair of bits in each of @var{@1@} and @var{@2@}.
-")
-
-DEFDOC (IOR, "Boolean OR.", "\
-Returns value resulting from boolean OR of
-pair of bits in each of @var{@1@} and @var{@2@}.
-")
-
-DEFDOC (XOR, "Boolean XOR.", "\
-Returns value resulting from boolean exclusive-OR of
-pair of bits in each of @var{@1@} and @var{@2@}.
-")
-
-DEFDOC (IEOR, "Boolean XOR.", "\
-Returns value resulting from boolean exclusive-OR of
-pair of bits in each of @var{@1@} and @var{@2@}.
-")
-
-DEFDOC (NOT, "Boolean NOT.", "\
-Returns value resulting from boolean NOT of each bit
-in @var{@1@}.
-")
-
-DEFDOC (ASIN, "Arc sine.", "\
-Returns the arc-sine (inverse sine) of @var{@1@}
-in radians.
-
-@xref{Sin Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (DASIN, "Arc sine (archaic).", ARCHAIC (ASIN, ASin))
-
-DEFDOC (ATAN, "Arc tangent.", "\
-Returns the arc-tangent (inverse tangent) of @var{@1@}
-in radians.
-
-@xref{Tan Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (DATAN, "Arc tangent (archaic).", ARCHAIC (ATAN, ATan))
-
-DEFDOC (ATAN2, "Arc tangent.", "\
-Returns the arc-tangent (inverse tangent) of the complex
-number (@var{@1@}, @var{@2@}) in radians.
-
-@xref{Tan Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (DATAN2, "Arc tangent (archaic).", ARCHAIC_2 (ATAN2, ATan2))
-
-DEFDOC (BIT_SIZE, "Number of bits in argument's type.", "\
-Returns the number of bits (integer precision plus sign bit)
-represented by the type for @var{@1@}.
-
-@xref{BTest Intrinsic}, for how to test the value of a
-bit in a variable or array.
-
-@xref{IBSet Intrinsic}, for how to set a bit in a variable to 1.
-
-@xref{IBClr Intrinsic}, for how to set a bit in a variable to 0.
-
-")
-
-DEFDOC (BTEST, "Test bit.", "\
-Returns @code{.TRUE.} if bit @var{@2@} in @var{@1@} is
-1, @code{.FALSE.} otherwise.
-
-(Bit 0 is the low-order (rightmost) bit, adding the value 
-@ifinfo
-2**0,
-@end ifinfo
-@iftex
-@tex
-$2^0$,
-@end tex
-@end iftex
-or 1,
-to the number if set to 1;
-bit 1 is the next-higher-order bit, adding 
-@ifinfo
-2**1,
-@end ifinfo
-@iftex
-@tex
-$2^1$,
-@end tex
-@end iftex
-or 2;
-bit 2 adds 
-@ifinfo
-2**2,
-@end ifinfo
-@iftex
-@tex
-$2^2$,
-@end tex
-@end iftex
-or 4; and so on.)
-
-@xref{Bit_Size Intrinsic}, for how to obtain the number of bits
-in a type.
-The leftmost bit of @var{@1@} is @samp{BIT_SIZE(@var{@1@}-1)}.
-")
-
-DEFDOC (CMPLX, "Construct @code{COMPLEX(KIND=1)} value.", "\
-If @var{@1@} is not type @code{COMPLEX},
-constructs a value of type @code{COMPLEX(KIND=1)} from the
-real and imaginary values specified by @var{@1@} and
-@var{@2@}, respectively.
-If @var{@2@} is omitted, @samp{0.} is assumed.
-
-If @var{@1@} is type @code{COMPLEX},
-converts it to type @code{COMPLEX(KIND=1)}.
-
-@xref{Complex Intrinsic}, for information on easily constructing
-a @code{COMPLEX} value of arbitrary precision from @code{REAL}
-arguments.
-")
-
-DEFDOC (DCMPLX, "Construct @code{COMPLEX(KIND=2)} value.", "\
-If @var{@1@} is not type @code{COMPLEX},
-constructs a value of type @code{COMPLEX(KIND=2)} from the
-real and imaginary values specified by @var{@1@} and
-@var{@2@}, respectively.
-If @var{@2@} is omitted, @samp{0D0} is assumed.
-
-If @var{@1@} is type @code{COMPLEX},
-converts it to type @code{COMPLEX(KIND=2)}.
-
-Although this intrinsic is not standard Fortran,
-it is a popular extension offered by many compilers
-that support @code{DOUBLE COMPLEX}, since it offers
-the easiest way to convert to @code{DOUBLE COMPLEX}
-without using Fortran 90 features (such as the @samp{KIND=}
-argument to the @code{CMPLX()} intrinsic).
-
-(@samp{CMPLX(0D0, 0D0)} returns a single-precision
-@code{COMPLEX} result, as required by standard FORTRAN 77.
-That's why so many compilers provide @code{DCMPLX()}, since
-@samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX}
-result.
-Still, @code{DCMPLX()} converts even @code{REAL*16} arguments
-to their @code{REAL*8} equivalents in most dialects of
-Fortran, so neither it nor @code{CMPLX()} allow easy
-construction of arbitrary-precision values without
-potentially forcing a conversion involving extending or
-reducing precision.
-GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.)
-
-@xref{Complex Intrinsic}, for information on easily constructing
-a @code{COMPLEX} value of arbitrary precision from @code{REAL}
-arguments.
-")
-
-DEFDOC (CONJG, "Complex conjugate.", "\
-Returns the complex conjugate:
-
-@example
-COMPLEX(REALPART(@var{@1@}), -IMAGPART(@var{@1@}))
-@end example
-")
-
-DEFDOC (DCONJG, "Complex conjugate (archaic).", ARCHAIC (CONJG, Conjg))
-
-DEFDOC (COS, "Cosine.", "\
-Returns the cosine of @var{@1@}, an angle measured
-in radians.
-
-@xref{ACos Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (CCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
-
-DEFDOC (DCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
-
-DEFDOC (CDCOS, "Cosine (archaic).", ARCHAIC (COS, Cos))
-
-DEFDOC (COSH, "Hyperbolic cosine.", "\
-Returns the hyperbolic cosine of @var{@1@}.
-")
-
-DEFDOC (DCOSH, "Hyperbolic cosine (archaic).", ARCHAIC (COSH, CosH))
-
-DEFDOC (SQRT, "Square root.", "\
-Returns the square root of @var{@1@}, which must
-not be negative.
-
-To calculate and represent the square root of a negative
-number, complex arithmetic must be used.
-For example, @samp{SQRT(COMPLEX(@var{@1@}))}.
-
-The inverse of this function is @samp{SQRT(@var{@1@}) * SQRT(@var{@1@})}.
-")
-
-DEFDOC (CSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
-
-DEFDOC (DSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
-
-DEFDOC (CDSQRT, "Square root (archaic).", ARCHAIC (SQRT, SqRt))
-
-DEFDOC (DBLE, "Convert to double precision.", "\
-Returns @var{@1@} converted to double precision
-(@code{REAL(KIND=2)}).
-If @var{@1@} is @code{COMPLEX}, the real part of
-@var{@1@} is used for the conversion
-and the imaginary part disregarded.
-
-@xref{Sngl Intrinsic}, for the function that converts
-to single precision.
-
-@xref{Int Intrinsic}, for the function that converts
-to @code{INTEGER}.
-
-@xref{Complex Intrinsic}, for the function that converts
-to @code{COMPLEX}.
-")
-
-DEFDOC (DIM, "Difference magnitude (non-negative subtract).", "\
-Returns @samp{@var{@1@}-@var{@2@}} if @var{@1@} is greater than
-@var{@2@}; otherwise returns zero.
-")
-
-DEFDOC (DDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM))
-DEFDOC (IDIM, "Difference magnitude (archaic).", ARCHAIC_2 (DIM, DiM))
-
-DEFDOC (DPROD, "Double-precision product.", "\
-Returns @samp{DBLE(@var{@1@})*DBLE(@var{@2@})}.
-")
-
-DEFDOC (EXP, "Exponential.", "\
-Returns @samp{@var{e}**@var{@1@}}, where
-@var{e} is approximately 2.7182818.
-
-@xref{Log Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (CEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
-
-DEFDOC (DEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
-
-DEFDOC (CDEXP, "Exponential (archaic).", ARCHAIC (EXP, Exp))
-
-DEFDOC (FLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real))
-DEFDOC (DFLOAT, "Conversion (archaic).", ARCHAIC (REAL, Real))
-
-DEFDOC (IFIX, "Conversion (archaic).", ARCHAIC (INT, Int))
-
-DEFDOC (LONG, "Conversion to @code{INTEGER(KIND=1)} (archaic).", "\
-Archaic form of @code{INT()} that is specific
-to one type for @var{@1@}.
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-")
-
-DEFDOC (SHORT, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=6)}.
-
-If @var{@1@} is type @code{COMPLEX}, its real part
-is truncated and converted, and its imaginary part is disregarded.
-
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-")
-
-DEFDOC (INT2, "Convert to @code{INTEGER(KIND=6)} value@99@truncated to whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=6)}.
-
-If @var{@1@} is type @code{COMPLEX}, its real part
-is truncated and converted, and its imaginary part is disregarded.
-
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-")
-
-DEFDOC (INT8, "Convert to @code{INTEGER(KIND=2)} value@99@truncated to whole number.", "\
-Returns @var{@1@} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=2)}.
-
-If @var{@1@} is type @code{COMPLEX}, its real part
-is truncated and converted, and its imaginary part is disregarded.
-
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-")
-
-DEFDOC (LEN, "Length of character entity.", "\
-Returns the length of @var{@1@}.
-
-If @var{@1@} is an array, the length of an element
-of @var{@1@} is returned.
-
-Note that @var{@1@} need not be defined when this
-intrinsic is invoked, since only the length, not
-the content, of @var{@1@} is needed.
-
-@xref{Bit_Size Intrinsic}, for the function that determines
-the size of its argument in bits.
-")
-
-DEFDOC (TAN, "Tangent.", "\
-Returns the tangent of @var{@1@}, an angle measured
-in radians.
-
-@xref{ATan Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (DTAN, "Tangent (archaic).", ARCHAIC (TAN, Tan))
-
-DEFDOC (TANH, "Hyperbolic tangent.", "\
-Returns the hyperbolic tangent of @var{@1@}.
-")
-
-DEFDOC (DTANH, "Hyperbolic tangent (archaic).", ARCHAIC (TANH, TanH))
-
-DEFDOC (SNGL, "Convert (archaic).", ARCHAIC (REAL, Real))
-
-DEFDOC (SIN, "Sine.", "\
-Returns the sine of @var{@1@}, an angle measured
-in radians.
-
-@xref{ASin Intrinsic}, for the inverse of this function.
-")
-
-DEFDOC (CSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
-
-DEFDOC (DSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
-
-DEFDOC (CDSIN, "Sine (archaic).", ARCHAIC (SIN, Sin))
-
-DEFDOC (SINH, "Hyperbolic sine.", "\
-Returns the hyperbolic sine of @var{@1@}.
-")
-
-DEFDOC (DSINH, "Hyperbolic sine (archaic).", ARCHAIC (SINH, SinH))
-
-DEFDOC (LSHIFT, "Left-shift bits.", "\
-Returns @var{@1@} shifted to the left
-@var{@2@} bits.
-
-Although similar to the expression
-@samp{@var{@1@}*(2**@var{@2@})}, there
-are important differences.
-For example, the sign of the result is
-not necessarily the same as the sign of
-@var{@1@}.
-
-Currently this intrinsic is defined assuming
-the underlying representation of @var{@1@}
-is as a two's-complement integer.
-It is unclear at this point whether that
-definition will apply when a different
-representation is involved.
-
-@xref{LShift Intrinsic}, for the inverse of this function.
-
-@xref{IShft Intrinsic}, for information
-on a more widely available left-shifting
-intrinsic that is also more precisely defined.
-")
-
-DEFDOC (RSHIFT, "Right-shift bits.", "\
-Returns @var{@1@} shifted to the right
-@var{@2@} bits.
-
-Although similar to the expression
-@samp{@var{@1@}/(2**@var{@2@})}, there
-are important differences.
-For example, the sign of the result is
-undefined.
-
-Currently this intrinsic is defined assuming
-the underlying representation of @var{@1@}
-is as a two's-complement integer.
-It is unclear at this point whether that
-definition will apply when a different
-representation is involved.
-
-@xref{RShift Intrinsic}, for the inverse of this function.
-
-@xref{IShft Intrinsic}, for information
-on a more widely available right-shifting
-intrinsic that is also more precisely defined.
-")
-
-DEFDOC (LGE, "Lexically greater than or equal.", "\
-Returns @samp{.TRUE.} if @samp{@var{@1@}.GE.@var{@2@}},
-@samp{.FALSE.} otherwise.
-@var{@1@} and @var{@2@} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{@1@} and @var{@2@} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-The lexical comparison intrinsics @code{LGe}, @code{LGt},
-@code{LLe}, and @code{LLt} differ from the corresponding
-intrinsic operators @code{.GE.}, @code{.GT.},
-@code{.LE.}, @code{.LT.}.
-Because the ASCII collating sequence is assumed,
-the following expressions always return @samp{.TRUE.}:
-
-@smallexample
-LGE ('0', ' ')
-LGE ('A', '0')
-LGE ('a', 'A')
-@end smallexample
-
-The following related expressions do @emph{not} always
-return @samp{.TRUE.}, as they are not necessarily evaluated
-assuming the arguments use ASCII encoding:
-
-@smallexample
-'0' .GE. ' '
-'A' .GE. '0'
-'a' .GE. 'A'
-@end smallexample
-
-The same difference exists
-between @code{LGt} and @code{.GT.};
-between @code{LLe} and @code{.LE.}; and
-between @code{LLt} and @code{.LT.}.
-")
-
-DEFDOC (LGT, "Lexically greater than.", "\
-Returns @samp{.TRUE.} if @samp{@var{@1@}.GT.@var{@2@}},
-@samp{.FALSE.} otherwise.
-@var{@1@} and @var{@2@} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{@1@} and @var{@2@} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-@xref{LGe Intrinsic}, for information on the distinction
-between the @code{@0@} intrinsic and the @code{.GT.}
-operator.
-")
-
-DEFDOC (LLE, "Lexically less than or equal.", "\
-Returns @samp{.TRUE.} if @samp{@var{@1@}.LE.@var{@2@}},
-@samp{.FALSE.} otherwise.
-@var{@1@} and @var{@2@} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{@1@} and @var{@2@} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-@xref{LGe Intrinsic}, for information on the distinction
-between the @code{@0@} intrinsic and the @code{.LE.}
-operator.
-")
-
-DEFDOC (LLT, "Lexically less than.", "\
-Returns @samp{.TRUE.} if @samp{@var{@1@}.LT.@var{@2@}},
-@samp{.FALSE.} otherwise.
-@var{@1@} and @var{@2@} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{@1@} and @var{@2@} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-@xref{LGe Intrinsic}, for information on the distinction
-between the @code{@0@} intrinsic and the @code{.LT.}
-operator.
-")
-
-DEFDOC (SIGN, "Apply sign to magnitude.", "\
-Returns @samp{ABS(@var{@1@})*@var{s}}, where
-@var{s} is +1 if @samp{@var{@2@}.GE.0},
--1 otherwise.
-
-@xref{Abs Intrinsic}, for the function that returns
-the magnitude of a value.
-")
-
-DEFDOC (DSIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign))
-DEFDOC (ISIGN, "Apply sign to magnitude (archaic).", ARCHAIC_2 (SIGN, Sign))
-
-DEFDOC (REAL, "Convert value to type @code{REAL(KIND=1)}.", "\
-Converts @var{@1@} to @code{REAL(KIND=1)}.
-
-Use of @code{@0@()} with a @code{COMPLEX} argument
-(other than @code{COMPLEX(KIND=1)}) is restricted to the following case:
-
-@example
-REAL(REAL(@1@))
-@end example
-
-@noindent
-This expression converts the real part of @1@ to
-@code{REAL(KIND=1)}.
-
-@xref{RealPart Intrinsic}, for information on a GNU Fortran
-intrinsic that extracts the real part of an arbitrary
-@code{COMPLEX} value.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-")
-
-DEFDOC (DREAL, "Convert value to type @code{REAL(KIND=2)}.", "\
-Converts @var{@1@} to @code{REAL(KIND=2)}.
-
-If @var{@1@} is type @code{COMPLEX}, its real part
-is converted (if necessary) to @code{REAL(KIND=2)},
-and its imaginary part is disregarded.
-
-Although this intrinsic is not standard Fortran,
-it is a popular extension offered by many compilers
-that support @code{DOUBLE COMPLEX}, since it offers
-the easiest way to extract the real part of a @code{DOUBLE COMPLEX}
-value without using the Fortran 90 @code{REAL()} intrinsic
-in a way that produces a return value inconsistent with
-the way many FORTRAN 77 compilers handle @code{REAL()} of
-a @code{DOUBLE COMPLEX} value.
-
-@xref{RealPart Intrinsic}, for information on a GNU Fortran
-intrinsic that avoids these areas of confusion.
-
-@xref{Dble Intrinsic}, for information on the standard FORTRAN 77
-replacement for @code{DREAL()}.
-
-@xref{REAL() and AIMAG() of Complex}, for more information on
-this issue.
-")
-
-DEFDOC (IMAGPART, "Extract imaginary part of complex.", "\
-The imaginary part of @var{@1@} is returned, without conversion.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is @samp{AIMAG(@var{@1@})}.
-However, when, for example, @var{@1@} is @code{DOUBLE COMPLEX},
-@samp{AIMAG(@var{@1@})} means something different for some compilers
-that are not true Fortran 90 compilers but offer some
-extensions standardized by Fortran 90 (such as the
-@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
-
-The advantage of @code{@0@()} is that, while not necessarily
-more or less portable than @code{AIMAG()}, it is more likely to
-cause a compiler that doesn't support it to produce a diagnostic
-than generate incorrect code.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-")
-
-DEFDOC (COMPLEX, "Build complex value from real and@99@imaginary parts.", "\
-Returns a @code{COMPLEX} value that has @samp{@1@} and @samp{@2@} as its
-real and imaginary parts, respectively.
-
-If @var{@1@} and @var{@2@} are the same type, and that type is not
-@code{INTEGER}, no data conversion is performed, and the type of
-the resulting value has the same kind value as the types
-of @var{@1@} and @var{@2@}.
-
-If @var{@1@} and @var{@2@} are not the same type, the usual type-promotion
-rules are applied to both, converting either or both to the
-appropriate @code{REAL} type.
-The type of the resulting value has the same kind value as the
-type to which both @var{@1@} and @var{@2@} were converted, in this case.
-
-If @var{@1@} and @var{@2@} are both @code{INTEGER}, they are both converted
-to @code{REAL(KIND=1)}, and the result of the @code{@0@()}
-invocation is type @code{COMPLEX(KIND=1)}.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is too hairy to describe here, but it is important to
-note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)}
-result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}.
-Hence the availability of @code{COMPLEX()} in GNU Fortran.
-")
-
-DEFDOC (LOC, "Address of entity in core.", "\
-The @code{LOC()} intrinsic works the
-same way as the @code{%LOC()} construct.
-@xref{%LOC(),,The @code{%LOC()} Construct}, for
-more information.
-")
-
-DEFDOC (REALPART, "Extract real part of complex.", "\
-The real part of @var{@1@} is returned, without conversion.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is @samp{REAL(@var{@1@})}.
-However, when, for example, @var{@1@} is @code{COMPLEX(KIND=2)},
-@samp{REAL(@var{@1@})} means something different for some compilers
-that are not true Fortran 90 compilers but offer some
-extensions standardized by Fortran 90 (such as the
-@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
-
-The advantage of @code{@0@()} is that, while not necessarily
-more or less portable than @code{REAL()}, it is more likely to
-cause a compiler that doesn't support it to produce a diagnostic
-than generate incorrect code.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-")
-
-DEFDOC (GETARG, "Obtain command-line argument.", "\
-Sets @var{@2@} to the @var{@1@}-th command-line argument (or to all
-blanks if there are fewer than @var{@2@} command-line arguments);
-@code{CALL @0@(0, @var{value})} sets @var{value} to the name of the
-program (on systems that support this feature).
-
-@xref{IArgC Intrinsic}, for information on how to get the number
-of arguments.
-")
-
-DEFDOC (ABORT, "Abort the program.", "\
-Prints a message and potentially causes a core dump via @code{abort(3)}.
-")
-
-DEFDOC (EXIT, "Terminate the program.", "\
-Exit the program with status @var{@1@} after closing open Fortran
-I/O units and otherwise behaving as @code{exit(2)}.
-If @var{@1@} is omitted the canonical `success' value
-will be returned to the system.
-")
-
-DEFDOC (IARGC, "Obtain count of command-line arguments.", "\
-Returns the number of command-line arguments.
-
-This count does not include the specification of the program
-name itself.
-")
-
-DEFDOC (CTIME_func, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\
-Converts @var{@1@}, a system time value, such as returned by
-@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
-and returns that string as the function value.
-
-@xref{Time8 Intrinsic}.
-")
-
-DEFDOC (CTIME_subr, "Convert time to Day Mon dd hh:mm:ss yyyy.", "\
-Converts @var{@1@}, a system time value, such as returned by
-@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
-and returns that string in @var{@2@}.
-
-@xref{Time8 Intrinsic}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (DATE, "Get current date as dd-Mon-yy.", "\
-Returns @var{@1@} in the form @samp{@var{dd}-@var{mmm}-@var{yy}},
-representing the numeric day of the month @var{dd}, a three-character
-abbreviation of the month name @var{mmm} and the last two digits of
-the year @var{yy}, e.g.@: @samp{25-Nov-96}.
-
-@cindex Y2K compliance
-@cindex Year 2000 compliance
-This intrinsic is not recommended, due to the year 2000 approaching.
-Therefore, programs making use of this intrinsic
-might not be Year 2000 (Y2K) compliant.
-@xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits
-for the current (or any) date.
-")
-
-DEFDOC (DTIME_func, "Get elapsed time since last time.", "\
-Initially, return the number of seconds of runtime
-since the start of the process's execution
-as the function value,
-and the user and system components of this in @samp{@var{@1@}(1)}
-and @samp{@var{@1@}(2)} respectively.
-The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
-
-Subsequent invocations of @samp{@0@()} return values accumulated since the
-previous invocation.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (DTIME_subr, "Get elapsed time since last time.", "\
-Initially, return the number of seconds of runtime
-since the start of the process's execution
-in @var{@2@},
-and the user and system components of this in @samp{@var{@1@}(1)}
-and @samp{@var{@1@}(2)} respectively.
-The value of @var{@2@} is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
-
-Subsequent invocations of @samp{@0@()} set values based on accumulations
-since the previous invocation.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (ETIME_func, "Get elapsed time for process.", "\
-Return the number of seconds of runtime
-since the start of the process's execution
-as the function value,
-and the user and system components of this in @samp{@var{@1@}(1)}
-and @samp{@var{@1@}(2)} respectively.
-The functions' value is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-")
-
-DEFDOC (ETIME_subr, "Get elapsed time for process.", "\
-Return the number of seconds of runtime
-since the start of the process's execution
-in @var{@2@},
-and the user and system components of this in @samp{@var{@1@}(1)}
-and @samp{@var{@1@}(2)} respectively.
-The value of @var{@2@} is equal to @samp{@var{@1@}(1) + @var{@1@}(2)}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (FDATE_func, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\
-Returns the current date (using the same format as @code{CTIME()}).
-
-Equivalent to:
-
-@example
-CTIME(TIME8())
-@end example
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-@xref{CTime Intrinsic (function)}.
-")
-
-DEFDOC (FDATE_subr, "Get current time as Day Mon dd hh:mm:ss yyyy.", "\
-Returns the current date (using the same format as @code{CTIME()})
-in @var{@1@}.
-
-Equivalent to:
-
-@example
-CALL CTIME(@var{@1@}, TIME8())
-@end example
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-@xref{CTime Intrinsic (subroutine)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (GMTIME, "Convert time to GMT time info.", "\
-Given a system time value @var{@1@}, fills @var{@2@} with values
-extracted from it appropriate to the GMT time zone using
-@code{gmtime(3)}.
-
-The array elements are as follows:
-
-@enumerate
-@item
-Seconds after the minute, range 0--59 or 0--61 to allow for leap
-seconds
-
-@item
-Minutes after the hour, range 0--59
-
-@item
-Hours past midnight, range 0--23
-
-@item
-Day of month, range 0--31
-
-@item
-Number of months since January, range 0--12
-
-@item
-Years since 1900
-
-@item
-Number of days since Sunday, range 0--6
-
-@item
-Days since January 1
-
-@item
-Daylight savings indicator: positive if daylight savings is in effect,
-zero if not, and negative if the information isn't available.
-@end enumerate
-")
-
-DEFDOC (LTIME, "Convert time to local time info.", "\
-Given a system time value @var{@1@}, fills @var{@2@} with values
-extracted from it appropriate to the GMT time zone using
-@code{localtime(3)}.
-
-The array elements are as follows:
-
-@enumerate
-@item
-Seconds after the minute, range 0--59 or 0--61 to allow for leap
-seconds
-
-@item
-Minutes after the hour, range 0--59
-
-@item
-Hours past midnight, range 0--23
-
-@item
-Day of month, range 0--31
-
-@item
-Number of months since January, range 0--12
-
-@item
-Years since 1900
-
-@item
-Number of days since Sunday, range 0--6
-
-@item
-Days since January 1
-
-@item
-Daylight savings indicator: positive if daylight savings is in effect,
-zero if not, and negative if the information isn't available.
-@end enumerate
-")
-
-DEFDOC (IDATE_unix, "Get local time info.", "\
-Fills @var{@1@} with the numerical values at the current local time.
-The day (in the range 1--31), month (in the range 1--12),
-and year appear in elements 1, 2, and 3 of @var{@1@}, respectively.
-The year has four significant digits.
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-")
-
-DEFDOC (IDATE_vxt, "Get local time info (VAX/VMS).", "\
-Returns the numerical values of the current local time.
-The month (in the range 1--12) is returned in @var{@1@},
-the day (in the range 1--31) in @var{@2@},
-and the year in @var{@3@} (in the range 0--99).
-
-@cindex Y2K compliance
-@cindex Year 2000 compliance
-@cindex wraparound, Y2K
-@cindex limits, Y2K
-This intrinsic is not recommended, due to the fact that
-its return value for year wraps around century boundaries
-(change from a larger value to a smaller one).
-Therefore, programs making use of this intrinsic, for
-instance, might not be Year 2000 (Y2K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-as of the Year 2000.
-
-@xref{IDate Intrinsic (UNIX)}, for information on obtaining more digits
-for the current date.
-")
-
-DEFDOC (ITIME, "Get local time of day.", "\
-Returns the current local time hour, minutes, and seconds in elements
-1, 2, and 3 of @var{@1@}, respectively.
-")
-
-DEFDOC (MCLOCK, "Get number of clock ticks for process.", "\
-Returns the number of clock ticks since the start of the process.
-Supported on systems with @code{clock(3)} (q.v.).
-
-@cindex wraparound, timings
-@cindex limits, timings
-This intrinsic is not fully portable, such as to systems
-with 32-bit @code{INTEGER} types but supporting times
-wider than 32 bits.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-@xref{MClock8 Intrinsic}, for information on a
-similar intrinsic that might be portable to more
-GNU Fortran implementations, though to fewer
-Fortran compilers.
-
-If the system does not support @code{clock(3)},
--1 is returned.
-")
-
-DEFDOC (MCLOCK8, "Get number of clock ticks for process.", "\
-Returns the number of clock ticks since the start of the process.
-Supported on systems with @code{clock(3)} (q.v.).
-
-@cindex wraparound, timings
-@cindex limits, timings
-@emph{Warning:} this intrinsic does not increase the range
-of the timing values over that returned by @code{clock(3)}.
-On a system with a 32-bit @code{clock(3)},
-@code{@0@} will return a 32-bit value,
-even though converted to an @samp{INTEGER(KIND=2)} value.
-That means overflows of the 32-bit value can still occur.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-No Fortran implementations other than GNU Fortran are
-known to support this intrinsic at the time of this
-writing.
-@xref{MClock Intrinsic}, for information on a
-similar intrinsic that might be portable to more Fortran
-compilers, though to fewer GNU Fortran implementations.
-
-If the system does not support @code{clock(3)},
--1 is returned.
-")
-
-DEFDOC (SECNDS, "Get local time offset since midnight.", "\
-Returns the local time in seconds since midnight minus the value
-@var{@1@}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-This values returned by this intrinsic
-become numerically less than previous values
-(they wrap around) during a single run of the
-compiler program, under normal circumstances
-(such as running through the midnight hour).
-")
-
-DEFDOC (SECOND_func, "Get CPU time for process in seconds.", "\
-Returns the process's runtime in seconds---the same value as the
-UNIX function @code{etime} returns.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-")
-
-DEFDOC (SECOND_subr, "Get CPU time for process@99@in seconds.", "\
-Returns the process's runtime in seconds in @var{@1@}---the same value
-as the UNIX function @code{etime} returns.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-This routine is known from Cray Fortran.  @xref{CPU_Time Intrinsic},
-for a standard equivalent.
-")
-
-DEFDOC (SYSTEM_CLOCK, "Get current system clock value.", "\
-Returns in @var{@1@} the current value of the system clock; this is
-the value returned by the UNIX function @code{times(2)}
-in this implementation, but
-isn't in general.
-@var{@2@} is the number of clock ticks per second and
-@var{@3@} is the maximum value this can take, which isn't very useful
-in this implementation since it's just the maximum C @code{unsigned
-int} value.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-")
-
-DEFDOC (CPU_TIME, "Get current CPU time.", "\
-Returns in @var{@1@} the current value of the system time.
-This implementation of the Fortran 95 intrinsic is just an alias for
-@code{second} @xref{Second Intrinsic (subroutine)}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-")
-
-DEFDOC (TIME8, "Get current time as time value.", "\
-Returns the current time encoded as a long integer
-(in the manner of the UNIX function @code{time(3)}).
-This value is suitable for passing to @code{CTIME},
-@code{GMTIME}, and @code{LTIME}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-@emph{Warning:} this intrinsic does not increase the range
-of the timing values over that returned by @code{time(3)}.
-On a system with a 32-bit @code{time(3)},
-@code{@0@} will return a 32-bit value,
-even though converted to an @samp{INTEGER(KIND=2)} value.
-That means overflows of the 32-bit value can still occur.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-No Fortran implementations other than GNU Fortran are
-known to support this intrinsic at the time of this
-writing.
-@xref{Time Intrinsic (UNIX)}, for information on a
-similar intrinsic that might be portable to more Fortran
-compilers, though to fewer GNU Fortran implementations.
-")
-
-DEFDOC (TIME_unix, "Get current time as time value.", "\
-Returns the current time encoded as an integer
-(in the manner of the UNIX function @code{time(3)}).
-This value is suitable for passing to @code{CTIME},
-@code{GMTIME}, and @code{LTIME}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-This intrinsic is not fully portable, such as to systems
-with 32-bit @code{INTEGER} types but supporting times
-wider than 32 bits.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-@xref{Time8 Intrinsic}, for information on a
-similar intrinsic that might be portable to more
-GNU Fortran implementations, though to fewer
-Fortran compilers.
-")
-
-#define BES(num,n,val) "\
-Calculates the Bessel function of the " #num " kind of \
-order " #n " of @var{@" #val "@}.\n\
-See @code{bessel(3m)}, on whose implementation the \
-function depends.\
-"
-
-DEFDOC (BESJ0, "Bessel function.", BES (first, 0, 1))
-DEFDOC (BESJ1, "Bessel function.", BES (first, 1, 1))
-DEFDOC (BESJN, "Bessel function.", BES (first, @var{N}, 2))
-DEFDOC (BESY0, "Bessel function.", BES (second, 0, 1))
-DEFDOC (BESY1, "Bessel function.", BES (second, 1, 1))
-DEFDOC (BESYN, "Bessel function.", BES (second, @var{N}, 2))
-DEFDOC (DBESJ0, "Bessel function (archaic).", ARCHAIC (BESJ0, BesJ0))
-DEFDOC (DBESJ1, "Bessel function (archaic).", ARCHAIC (BESJ1, BesJ1))
-DEFDOC (DBESJN, "Bessel function (archaic).", ARCHAIC_2nd (BESJN, BesJN))
-DEFDOC (DBESY0, "Bessel function (archaic).", ARCHAIC (BESY0, BesY0))
-DEFDOC (DBESY1, "Bessel function (archaic).", ARCHAIC (BESY1, BesY1))
-DEFDOC (DBESYN, "Bessel function (archaic).", ARCHAIC_2nd (BESYN, BesYN))
-
-DEFDOC (ERF, "Error function.", "\
-Returns the error function of @var{@1@}.
-See @code{erf(3m)}, which provides the implementation.
-")
-
-DEFDOC (ERFC, "Complementary error function.", "\
-Returns the complementary error function of @var{@1@}:
-@samp{ERFC(R) = 1 - ERF(R)} (except that the result might be more
-accurate than explicitly evaluating that formulae would give).
-See @code{erfc(3m)}, which provides the implementation.
-")
-
-DEFDOC (DERF, "Error function (archaic).", ARCHAIC (ERF, ErF))
-DEFDOC (DERFC, "Complementary error function (archaic).", ARCHAIC (ERFC, ErFC))
-
-DEFDOC (IRAND, "Random number.", "\
-Returns a uniform quasi-random number up to a system-dependent limit.
-If @var{@1@} is 0, the next number in sequence is returned; if
-@var{@1@} is 1, the generator is restarted by calling the UNIX function
-@samp{srand(0)}; if @var{@1@} has any other value,
-it is used as a new seed with @code{srand()}.
-
-@xref{SRand Intrinsic}.
-
-@emph{Note:} As typically implemented (by the routine of the same
-name in the C library), this random number generator is a very poor
-one, though the BSD and GNU libraries provide a much better
-implementation than the `traditional' one.
-On a different system you almost certainly want to use something better.
-")
-
-DEFDOC (RAND, "Random number.", "\
-Returns a uniform quasi-random number between 0 and 1.
-If @var{@1@} is 0, the next number in sequence is returned; if
-@var{@1@} is 1, the generator is restarted by calling @samp{srand(0)};
-if @var{@1@} has any other value, it is used as a new seed with
-@code{srand}.
-
-@xref{SRand Intrinsic}.
-
-@emph{Note:} As typically implemented (by the routine of the same
-name in the C library), this random number generator is a very poor
-one, though the BSD and GNU libraries provide a much better
-implementation than the `traditional' one.
-On a different system you
-almost certainly want to use something better.
-")
-
-DEFDOC (SRAND, "Random seed.", "\
-Reinitializes the generator with the seed in @var{@1@}.
-@xref{IRand Intrinsic}.
-@xref{Rand Intrinsic}.
-")
-
-DEFDOC (ACCESS, "Check file accessibility.", "\
-Checks file @var{@1@} for accessibility in the mode specified by @var{@2@} and
-returns 0 if the file is accessible in that mode, otherwise an error
-code if the file is inaccessible or @var{@2@} is invalid.
-See @code{access(2)}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-@var{@2@} may be a concatenation of any of the following characters:
-
-@table @samp
-@item r
-Read permission
-
-@item w
-Write permission
-
-@item x
-Execute permission
-
-@item @kbd{SPC}
-Existence
-@end table
-")
-
-DEFDOC (CHDIR_subr, "Change directory.", "\
-Sets the current working directory to be @var{@1@}.
-If the @var{@2@} argument is supplied, it contains 0
-on success or a nonzero error code otherwise upon return.
-See @code{chdir(3)}.
-
-@emph{Caution:} Using this routine during I/O to a unit connected with a
-non-absolute file name can cause subsequent I/O on such a unit to fail
-because the I/O library might reopen files by name.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@2@} argument.
-")
-
-DEFDOC (CHDIR_func, "Change directory.", "\
-Sets the current working directory to be @var{@1@}.
-Returns 0 on success or a nonzero error code.
-See @code{chdir(3)}.
-
-@emph{Caution:} Using this routine during I/O to a unit connected with a
-non-absolute file name can cause subsequent I/O on such a unit to fail
-because the I/O library might reopen files by name.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (CHMOD_func, "Change file modes.", "\
-Changes the access mode of file @var{@1@} according to the
-specification @var{@2@}, which is given in the format of
-@code{chmod(1)}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-Currently, @var{@1@} must not contain the single quote
-character.
-
-Returns 0 on success or a nonzero error code otherwise.
-
-Note that this currently works
-by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
-the library was configured) and so might fail in some circumstances and
-will, anyway, be slow.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (CHMOD_subr, "Change file modes.", "\
-Changes the access mode of file @var{@1@} according to the
-specification @var{@2@}, which is given in the format of
-@code{chmod(1)}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-Currently, @var{@1@} must not contain the single quote
-character.
-
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Note that this currently works
-by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
-the library was configured) and so might fail in some circumstances and
-will, anyway, be slow.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (GETCWD_func, "Get current working directory.", "\
-Places the current working directory in @var{@1@}.
-Returns 0 on
-success, otherwise a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
-or @code{getwd(3)}).
-")
-
-DEFDOC (GETCWD_subr, "Get current working directory.", "\
-Places the current working directory in @var{@1@}.
-If the @var{@2@} argument is supplied, it contains 0
-success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
-or @code{getwd(3)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@2@} argument.
-")
-
-DEFDOC (FSTAT_func, "Get file information.", "\
-Obtains data about the file open on Fortran I/O unit @var{@1@} and
-places them in the array @var{@2@}.
-The values in this array are
-extracted from the @code{stat} structure as returned by
-@code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-Returns 0 on success or a nonzero error code.
-")
-
-DEFDOC (FSTAT_subr, "Get file information.", "\
-Obtains data about the file open on Fortran I/O unit @var{@1@} and
-places them in the array @var{@2@}.
-The values in this array are
-extracted from the @code{stat} structure as returned by
-@code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (LSTAT_func, "Get file information.", "\
-Obtains data about the given file @var{@1@} and places them in the array
-@var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-If @var{@1@} is a symbolic link it returns data on the
-link itself, so the routine is available only on systems that support
-symbolic links.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-Returns 0 on success or a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
-")
-
-DEFDOC (LSTAT_subr, "Get file information.", "\
-Obtains data about the given file @var{@1@} and places them in the array
-@var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-If @var{@1@} is a symbolic link it returns data on the
-link itself, so the routine is available only on systems that support
-symbolic links.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (STAT_func, "Get file information.", "\
-Obtains data about the given file @var{@1@} and places them in the array
-@var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-Returns 0 on success or a nonzero error code.
-")
-
-DEFDOC (STAT_subr, "Get file information.", "\
-Obtains data about the given file @var{@1@} and places them in the array
-@var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (LINK_subr, "Make hard link in file system.", "\
-Makes a (hard) link from file @var{@1@} to @var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{@1@} and @var{@2@}---otherwise,
-trailing blanks in @var{@1@} and @var{@2@} are ignored.
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-See @code{link(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (LINK_func, "Make hard link in file system.", "\
-Makes a (hard) link from file @var{@1@} to @var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{@1@} and @var{@2@}---otherwise,
-trailing blanks in @var{@1@} and @var{@2@} are ignored.
-Returns 0 on success or a nonzero error code.
-See @code{link(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (SYMLNK_subr, "Make symbolic link in file system.", "\
-Makes a symbolic link from file @var{@1@} to @var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{@1@} and @var{@2@}---otherwise,
-trailing blanks in @var{@1@} and @var{@2@} are ignored.
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (SYMLNK_func, "Make symbolic link in file system.", "\
-Makes a symbolic link from file @var{@1@} to @var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{@1@} and @var{@2@}---otherwise,
-trailing blanks in @var{@1@} and @var{@2@} are ignored.
-Returns 0 on success or a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (RENAME_subr, "Rename file.", "\
-Renames the file @var{@1@} to @var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{@1@} and @var{@2@}---otherwise,
-trailing blanks in @var{@1@} and @var{@2@} are ignored.
-See @code{rename(2)}.
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (RENAME_func, "Rename file.", "\
-Renames the file @var{@1@} to @var{@2@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{@1@} and @var{@2@}---otherwise,
-trailing blanks in @var{@1@} and @var{@2@} are ignored.
-See @code{rename(2)}.
-Returns 0 on success or a nonzero error code.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (UMASK_subr, "Set file creation permissions mask.", "\
-Sets the file creation mask to @var{@1@} and returns the old value in
-argument @var{@2@} if it is supplied.
-See @code{umask(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (UMASK_func, "Set file creation permissions mask.", "\
-Sets the file creation mask to @var{@1@} and returns the old value.
-See @code{umask(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (UNLINK_subr, "Unlink file.", "\
-Unlink the file @var{@1@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-If the @var{@2@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-See @code{unlink(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@2@} argument.
-")
-
-DEFDOC (UNLINK_func, "Unlink file.", "\
-Unlink the file @var{@1@}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-Returns 0 on success or a nonzero error code.
-See @code{unlink(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (GERROR, "Get error message for last error.", "\
-Returns the system error message corresponding to the last system
-error (C @code{errno}).
-")
-
-DEFDOC (IERRNO, "Get error number for last error.", "\
-Returns the last system error number (corresponding to the C
-@code{errno}).
-")
-
-DEFDOC (PERROR, "Print error message for last error.", "\
-Prints (on the C @code{stderr} stream) a newline-terminated error
-message corresponding to the last system error.
-This is prefixed by @var{@1@}, a colon and a space.
-See @code{perror(3)}.
-")
- 
-DEFDOC (GETGID, "Get process group id.", "\
-Returns the group id for the current process.
-")
- 
-DEFDOC (GETUID, "Get process user id.", "\
-Returns the user id for the current process.
-")
- 
-DEFDOC (GETPID, "Get process id.", "\
-Returns the process id for the current process.
-")
-
-DEFDOC (GETENV, "Get environment variable.", "\
-Sets @var{@2@} to the value of environment variable given by the
-value of @var{@1@} (@code{$name} in shell terms) or to blanks if
-@code{$name} has not been set.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{@1@}---otherwise,
-trailing blanks in @var{@1@} are ignored.
-")
-
-DEFDOC (GETLOG, "Get login name.", "\
-Returns the login name for the process in @var{@1@}.
-
-@emph{Caution:} On some systems, the @code{getlogin(3)}
-function, which this intrinsic calls at run time,
-is either not implemented or returns a null pointer.
-In the latter case, this intrinsic returns blanks
-in @var{@1@}.
-")
-
-DEFDOC (HOSTNM_func, "Get host name.", "\
-Fills @var{@1@} with the system's host name returned by
-@code{gethostname(2)}, returning 0 on success or a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
-
-On some systems (specifically SCO) it might be necessary to link the
-``socket'' library if you call this routine.
-Typically this means adding @samp{-lg2c -lsocket -lm}
-to the @code{g77} command line when linking the program.
-")
-
-DEFDOC (HOSTNM_subr, "Get host name.", "\
-Fills @var{@1@} with the system's host name returned by
-@code{gethostname(2)}.
-If the @var{@2@} argument is supplied, it contains
-0 on success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@2@} argument.
-
-On some systems (specifically SCO) it might be necessary to link the
-``socket'' library if you call this routine.
-Typically this means adding @samp{-lg2c -lsocket -lm}
-to the @code{g77} command line when linking the program.
-")
-
-DEFDOC (FLUSH, "Flush buffered output.", "\
-Flushes Fortran unit(s) currently open for output.
-Without the optional argument, all such units are flushed,
-otherwise just the unit specified by @var{@1@}.
-
-Some non-GNU implementations of Fortran provide this intrinsic
-as a library procedure that might or might not support the
-(optional) @var{@1@} argument.
-")
-
-DEFDOC (FNUM, "Get file descriptor from Fortran unit number.", "\
-Returns the Unix file descriptor number corresponding to the open
-Fortran I/O unit @var{@1@}.
-This could be passed to an interface to C I/O routines.
-")
-
-#define IOWARN "
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-"
-
-DEFDOC (FGET_func, "Read a character from unit 5 stream-wise.", "\
-Reads a single character into @var{@1@} in stream mode from unit 5
-(by-passing normal formatted input) using @code{getc(3)}.
-Returns 0 on
-success, @minus{}1 on end-of-file, and the error code from
-@code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FGET_subr, "Read a character from unit 5 stream-wise.", "\
-Reads a single character into @var{@1@} in stream mode from unit 5
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns in
-@var{@2@} 0 on success, @minus{}1 on end-of-file, and the error code
-from @code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FGETC_func, "Read a character stream-wise.", "\
-Reads a single character into @var{@2@} in stream mode from unit @var{@1@}
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns 0 on
-success, @minus{}1 on end-of-file, and the error code from
-@code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FGETC_subr, "Read a character stream-wise.", "\
-Reads a single character into @var{@2@} in stream mode from unit @var{@1@}
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns in
-@var{@3@} 0 on success, @minus{}1 on end-of-file, and the error code from
-@code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FPUT_func, "Write a character to unit 6 stream-wise.", "\
-Writes the single character @var{@1@} in stream mode to unit 6
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns 0 on
-success, the error code from @code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FPUT_subr, "Write a character to unit 6 stream-wise.", "\
-Writes the single character @var{@1@} in stream mode to unit 6
-(by-passing normal formatted output) using @code{putc(3)}.
-Returns in
-@var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FPUTC_func, "Write a character stream-wise.", "\
-Writes the single character @var{@2@} in stream mode to unit @var{@1@}
-(by-passing normal formatted output) using @code{putc(3)}.
-Returns 0 on
-success, the error code from @code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FPUTC_subr, "Write a character stream-wise.", "\
-Writes the single character @var{@1@} in stream mode to unit 6
-(by-passing normal formatted output) using @code{putc(3)}.
-Returns in
-@var{@2@} 0 on success, the error code from @code{ferror(3)} otherwise.
-" IOWARN)
-
-DEFDOC (FSEEK, "Position file (low-level).", "\
-Attempts to move Fortran unit @var{@1@} to the specified
-@var{@2@}: absolute offset if @var{@3@}=0; relative to the
-current offset if @var{@3@}=1; relative to the end of the file if
-@var{@3@}=2.
-It branches to label @var{@4@} if @var{@1@} is
-not open or if the call otherwise fails.
-")
-
-DEFDOC (FTELL_func, "Get file position (low-level).", "\
-Returns the current offset of Fortran unit @var{@1@}
-(or @minus{}1 if @var{@1@} is not open).
-")
-
-DEFDOC (FTELL_subr, "Get file position (low-level).", "\
-Sets @var{@2@} to the current offset of Fortran unit @var{@1@}
-(or to @minus{}1 if @var{@1@} is not open).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (ISATTY, "Is unit connected to a terminal?", "\
-Returns @code{.TRUE.} if and only if the Fortran I/O unit
-specified by @var{@1@} is connected
-to a terminal device.
-See @code{isatty(3)}.
-")
-
-DEFDOC (TTYNAM_func, "Get name of terminal device for unit.", "\
-Returns the name of the terminal device open on logical unit
-@var{@1@} or a blank string if @var{@1@} is not connected to a
-terminal.
-")
-
-DEFDOC (TTYNAM_subr, "Get name of terminal device for unit.", "\
-Sets @var{@2@} to the name of the terminal device open on logical unit
-@var{@1@} or to a blank string if @var{@1@} is not connected to a
-terminal.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-")
-
-DEFDOC (SIGNAL_subr, "Muck with signal handling.", "\
-If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
-invoked with a single integer argument (of system-dependent length)
-when signal @var{@1@} occurs.
-If @var{@2@} is an integer, it can be
-used to turn off handling of signal @var{@1@} or revert to its default
-action.
-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 @code{LOC()}) to it.
-
-The value returned by @code{signal(2)} is written to @var{@3@}, if
-that argument is supplied.
-Otherwise the return value is ignored.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-
-@emph{Warning:} Use of the @code{libf2c} run-time library function
-@samp{signal_} directly
-(such as via @samp{EXTERNAL SIGNAL})
-requires use of the @code{%VAL()} construct
-to pass an @code{INTEGER} value
-(such as @samp{SIG_IGN} or @samp{SIG_DFL})
-for the @var{@2@} argument.
-
-However, while @samp{CALL SIGNAL(@var{signum}, %VAL(SIG_IGN))}
-works when @samp{SIGNAL} is treated as an external procedure
-(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
-this construct is not valid when @samp{SIGNAL} is recognized
-as the intrinsic of that name.
-
-Therefore, for maximum portability and reliability,
-code such references to the @samp{SIGNAL} facility as follows:
-
-@smallexample
-INTRINSIC SIGNAL
-@dots{}
-CALL SIGNAL(@var{signum}, SIG_IGN)
-@end smallexample
-
-@code{g77} will compile such a call correctly,
-while other compilers will generally either do so as well
-or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
-allowing you to take appropriate action.
-")
-
-DEFDOC (SIGNAL_func, "Muck with signal handling.", "\
-If @var{@2@} is a an @code{EXTERNAL} routine, arranges for it to be
-invoked with a single integer argument (of system-dependent length)
-when signal @var{@1@} occurs.
-If @var{@2@} is an integer, it can be
-used to turn off handling of signal @var{@1@} or revert to its default
-action.
-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 @code{LOC()}) to it.
-
-The value returned by @code{signal(2)} is returned.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-@emph{Warning:} If the returned value is stored in
-an @code{INTEGER(KIND=1)} (default @code{INTEGER}) argument,
-truncation of the original return value occurs on some systems
-(such as Alphas, which have 64-bit pointers but 32-bit default integers),
-with no warning issued by @code{g77} under normal circumstances.
-
-Therefore, the following code fragment might silently fail on
-some systems:
-
-@smallexample
-INTEGER RTN
-EXTERNAL MYHNDL
-RTN = SIGNAL(@var{signum}, MYHNDL)
-@dots{}
-! Restore original handler:
-RTN = SIGNAL(@var{signum}, RTN)
-@end smallexample
-
-The reason for the failure is that @samp{RTN} might not hold
-all the information on the original handler for the signal,
-thus restoring an invalid handler.
-This bug could manifest itself as a spurious run-time failure
-at an arbitrary point later during the program's execution,
-for example.
-
-@emph{Warning:} Use of the @code{libf2c} run-time library function
-@samp{signal_} directly
-(such as via @samp{EXTERNAL SIGNAL})
-requires use of the @code{%VAL()} construct
-to pass an @code{INTEGER} value
-(such as @samp{SIG_IGN} or @samp{SIG_DFL})
-for the @var{@2@} argument.
-
-However, while @samp{RTN = SIGNAL(@var{signum}, %VAL(SIG_IGN))}
-works when @samp{SIGNAL} is treated as an external procedure
-(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
-this construct is not valid when @samp{SIGNAL} is recognized
-as the intrinsic of that name.
-
-Therefore, for maximum portability and reliability,
-code such references to the @samp{SIGNAL} facility as follows:
-
-@smallexample
-INTRINSIC SIGNAL
-@dots{}
-RTN = SIGNAL(@var{signum}, SIG_IGN)
-@end smallexample
-
-@code{g77} will compile such a call correctly,
-while other compilers will generally either do so as well
-or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
-allowing you to take appropriate action.
-")
-
-DEFDOC (KILL_func, "Signal a process.", "\
-Sends the signal specified by @var{@2@} to the process @var{@1@}.
-Returns 0 on success or a nonzero error code.
-See @code{kill(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-")
-
-DEFDOC (KILL_subr, "Signal a process.", "\
-Sends the signal specified by @var{@2@} to the process @var{@1@}.
-If the @var{@3@} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-See @code{kill(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@3@} argument.
-")
-
-DEFDOC (LNBLNK, "Get last non-blank character in string.", "\
-Returns the index of the last non-blank character in @var{@1@}.
-@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
-")
-
-DEFDOC (SLEEP, "Sleep for a specified time.", "\
-Causes the process to pause for @var{@1@} seconds.
-See @code{sleep(2)}.
-")
-
-DEFDOC (SYSTEM_subr, "Invoke shell (system) command.", "\
-Passes the command @var{@1@} to a shell (see @code{system(3)}).
-If argument @var{@2@} is present, it contains the value returned by
-@code{system(3)}, presumably 0 if the shell command succeeded.
-Note that which shell is used to invoke the command is system-dependent
-and environment-dependent.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{@2@} argument.
-")
-
-DEFDOC (SYSTEM_func, "Invoke shell (system) command.", "\
-Passes the command @var{@1@} to a shell (see @code{system(3)}).
-Returns the value returned by
-@code{system(3)}, presumably 0 if the shell command succeeded.
-Note that which shell is used to invoke the command is system-dependent
-and environment-dependent.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-However, the function form can be valid in cases where the
-actual side effects performed by the call are unimportant to
-the application.
-
-For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')}
-does not perform any side effects likely to be important to the
-program, so the programmer would not care if the actual system
-call (and invocation of @code{cmp}) was optimized away in a situation
-where the return value could be determined otherwise, or was not
-actually needed (@samp{SAME} not actually referenced after the
-sample assignment statement).
-")
-
-DEFDOC (TIME_vxt, "Get the time as a character value.", "\
-Returns in @var{@1@} a character representation of the current time as
-obtained from @code{ctime(3)}.
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-@xref{FDate Intrinsic (subroutine)}, for an equivalent routine.
-")
-
-DEFDOC (IBCLR, "Clear a bit.", "\
-Returns the value of @var{@1@} with bit @var{@2@} cleared (set to
-zero).
-@xref{BTest Intrinsic}, for information on bit positions.
-")
-
-DEFDOC (IBSET, "Set a bit.", "\
-Returns the value of @var{@1@} with bit @var{@2@} set (to one).
-@xref{BTest Intrinsic}, for information on bit positions.
-")
-
-DEFDOC (IBITS, "Extract a bit subfield of a variable.", "\
-Extracts a subfield of length @var{@3@} from @var{@1@}, starting from
-bit position @var{@2@} and extending left for @var{@3@} bits.
-The result is right-justified and the remaining bits are zeroed.
-The value
-of @samp{@var{@2@}+@var{@3@}} must be less than or equal to the value
-@samp{BIT_SIZE(@var{@1@})}.
-@xref{Bit_Size Intrinsic}.
-")
-
-DEFDOC (ISHFT, "Logical bit shift.", "\
-All bits representing @var{@1@} are shifted @var{@2@} places.
-@samp{@var{@2@}.GT.0} indicates a left shift, @samp{@var{@2@}.EQ.0}
-indicates no shift and @samp{@var{@2@}.LT.0} indicates a right shift.
-If the absolute value of the shift count is greater than
-@samp{BIT_SIZE(@var{@1@})}, the result is undefined.
-Bits shifted out from the left end or the right end are lost.
-Zeros are shifted in from the opposite end.
-
-@xref{IShftC Intrinsic}, for the circular-shift equivalent.
-")
-
-DEFDOC (ISHFTC, "Circular bit shift.", "\
-The rightmost @var{@3@} bits of the argument @var{@1@}
-are shifted circularly @var{@2@}
-places, i.e.@: the bits shifted out of one end are shifted into 
-the opposite end.
-No bits are lost.
-The unshifted bits of the result are the same as
-the unshifted bits of @var{@1@}.
-The  absolute value of the argument @var{@2@}
-must be less than or equal to @var{@3@}.  
-The value of @var{@3@} must be greater than or equal to one and less than 
-or equal to @samp{BIT_SIZE(@var{@1@})}.
-
-@xref{IShft Intrinsic}, for the logical shift equivalent.
-")
-
-DEFDOC (MVBITS, "Moving a bit field.", "\
-Moves @var{@3@} bits from positions @var{@2@} through
-@samp{@var{@2@}+@var{@3@}-1} of @var{@1@} to positions @var{@5@} through
-@samp{@var{@2@}+@var{@3@}-1} of @var{@4@}.  The portion of argument
-@var{@4@} not affected by the movement of bits is unchanged.  Arguments
-@var{@1@} and @var{@4@} are permitted to be the same numeric storage
-unit.  The values of @samp{@var{@2@}+@var{@3@}} and
-@samp{@var{@5@}+@var{@3@}} must be less than or equal to
-@samp{BIT_SIZE(@var{@1@})}.
-")
-
-DEFDOC (INDEX, "Locate a CHARACTER substring.", "\
-Returns the position of the start of the first occurrence of string
-@var{@2@} as a substring in @var{@1@}, counting from one.
-If @var{@2@} doesn't occur in @var{@1@}, zero is returned.
-")
-
-DEFDOC (ALARM, "Execute a routine after a given delay.", "\
-Causes external subroutine @var{@2@} to be executed after a delay of
-@var{@1@} seconds by using @code{alarm(1)} to set up a signal and
-@code{signal(2)} to catch it.
-If @var{@3@} is supplied, it will be
-returned with the number of seconds remaining until any previously
-scheduled alarm was due to be delivered, or zero if there was no
-previously scheduled alarm.
-@xref{Signal Intrinsic (subroutine)}.
-")
-
-DEFDOC (DATE_AND_TIME, "Get the current date and time.", "\
-Returns:
-@table @var
-@item @1@
-The date in the form @var{ccyymmdd}: century, year, month and day;
-@item @2@
-The time in the form @samp{@var{hhmmss.ss}}: hours, minutes, seconds
-and milliseconds;
-@item @3@
-The difference between local time and UTC (GMT) in the form @var{Shhmm}:
-sign, hours and minutes, e.g.@: @samp{-0500} (winter in New York);
-@item @4@
-The year, month of the year, day of the month, time difference in
-minutes from UTC, hour of the day, minutes of the hour, seconds
-of the minute, and milliseconds
-of the second in successive values of the array.
-@end table
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-On systems where a millisecond timer isn't available, the millisecond
-value is returned as zero.
-")
diff --git a/gcc/f/intdoc.texi b/gcc/f/intdoc.texi
deleted file mode 100644
index e657510..0000000
--- a/gcc/f/intdoc.texi
+++ /dev/null
@@ -1,10931 +0,0 @@
-@c This file is automatically derived from intdoc.c, intdoc.in,
-@c ansify.c, intrin.def, and intrin.h.  Edit those files instead.
-@menu
-@ifset familyF2U
-* Abort Intrinsic::     Abort the program.
-@end ifset
-@ifset familyF77
-* Abs Intrinsic::       Absolute value.
-@end ifset
-@ifset familyF2U
-* Access Intrinsic::    Check file accessibility.
-@end ifset
-@ifset familyASC
-* AChar Intrinsic::     ASCII character from code.
-@end ifset
-@ifset familyF77
-* ACos Intrinsic::      Arc cosine.
-@end ifset
-@ifset familyVXT
-* ACosD Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* AdjustL Intrinsic::   (Reserved for future use.)
-* AdjustR Intrinsic::   (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* AImag Intrinsic::     Convert/extract imaginary part of complex.
-@end ifset
-@ifset familyVXT
-* AIMax0 Intrinsic::    (Reserved for future use.)
-* AIMin0 Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* AInt Intrinsic::      Truncate to whole number.
-@end ifset
-@ifset familyVXT
-* AJMax0 Intrinsic::    (Reserved for future use.)
-* AJMin0 Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* Alarm Intrinsic::     Execute a routine after a given delay.
-@end ifset
-@ifset familyF90
-* All Intrinsic::       (Reserved for future use.)
-* Allocated Intrinsic:: (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* ALog Intrinsic::      Natural logarithm (archaic).
-* ALog10 Intrinsic::    Common logarithm (archaic).
-* AMax0 Intrinsic::     Maximum value (archaic).
-* AMax1 Intrinsic::     Maximum value (archaic).
-* AMin0 Intrinsic::     Minimum value (archaic).
-* AMin1 Intrinsic::     Minimum value (archaic).
-* AMod Intrinsic::      Remainder (archaic).
-@end ifset
-@ifset familyF2C
-* And Intrinsic::       Boolean AND.
-@end ifset
-@ifset familyF77
-* ANInt Intrinsic::     Round to nearest whole number.
-@end ifset
-@ifset familyF90
-* Any Intrinsic::       (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* ASin Intrinsic::      Arc sine.
-@end ifset
-@ifset familyVXT
-* ASinD Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* Associated Intrinsic:: (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* ATan Intrinsic::      Arc tangent.
-* ATan2 Intrinsic::     Arc tangent.
-@end ifset
-@ifset familyVXT
-* ATan2D Intrinsic::    (Reserved for future use.)
-* ATanD Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* BesJ0 Intrinsic::     Bessel function.
-* BesJ1 Intrinsic::     Bessel function.
-* BesJN Intrinsic::     Bessel function.
-* BesY0 Intrinsic::     Bessel function.
-* BesY1 Intrinsic::     Bessel function.
-* BesYN Intrinsic::     Bessel function.
-@end ifset
-@ifset familyVXT
-* BITest Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* Bit_Size Intrinsic::  Number of bits in argument's type.
-@end ifset
-@ifset familyVXT
-* BJTest Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyMIL
-* BTest Intrinsic::     Test bit.
-@end ifset
-@ifset familyF77
-* CAbs Intrinsic::      Absolute value (archaic).
-* CCos Intrinsic::      Cosine (archaic).
-@end ifset
-@ifset familyFVZ
-* CDAbs Intrinsic::     Absolute value (archaic).
-* CDCos Intrinsic::     Cosine (archaic).
-* CDExp Intrinsic::     Exponential (archaic).
-* CDLog Intrinsic::     Natural logarithm (archaic).
-* CDSin Intrinsic::     Sine (archaic).
-* CDSqRt Intrinsic::    Square root (archaic).
-@end ifset
-@ifset familyF90
-* Ceiling Intrinsic::   (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* CExp Intrinsic::      Exponential (archaic).
-* Char Intrinsic::      Character from code.
-@end ifset
-@ifset familyF2U
-* ChDir Intrinsic (subroutine):: Change directory.
-@end ifset
-@ifset familyBADU77
-* ChDir Intrinsic (function):: Change directory.
-@end ifset
-@ifset familyF2U
-* ChMod Intrinsic (subroutine):: Change file modes.
-@end ifset
-@ifset familyBADU77
-* ChMod Intrinsic (function):: Change file modes.
-@end ifset
-@ifset familyF77
-* CLog Intrinsic::      Natural logarithm (archaic).
-* Cmplx Intrinsic::     Construct @code{COMPLEX(KIND=1)} value.
-@end ifset
-@ifset familyGNU
-* Complex Intrinsic::   Build complex value from real and
-                         imaginary parts.
-@end ifset
-@ifset familyF77
-* Conjg Intrinsic::     Complex conjugate.
-* Cos Intrinsic::       Cosine.
-@end ifset
-@ifset familyVXT
-* CosD Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* CosH Intrinsic::      Hyperbolic cosine.
-@end ifset
-@ifset familyF90
-* Count Intrinsic::     (Reserved for future use.)
-* CPU_Time Intrinsic::  Get current CPU time.
-* CShift Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* CSin Intrinsic::      Sine (archaic).
-* CSqRt Intrinsic::     Square root (archaic).
-@end ifset
-@ifset familyF2U
-* CTime Intrinsic (subroutine):: Convert time to Day Mon dd hh:mm:ss yyyy.
-* CTime Intrinsic (function):: Convert time to Day Mon dd hh:mm:ss yyyy.
-@end ifset
-@ifset familyF77
-* DAbs Intrinsic::      Absolute value (archaic).
-* DACos Intrinsic::     Arc cosine (archaic).
-@end ifset
-@ifset familyVXT
-* DACosD Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DASin Intrinsic::     Arc sine (archaic).
-@end ifset
-@ifset familyVXT
-* DASinD Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DATan Intrinsic::     Arc tangent (archaic).
-* DATan2 Intrinsic::    Arc tangent (archaic).
-@end ifset
-@ifset familyVXT
-* DATan2D Intrinsic::   (Reserved for future use.)
-* DATanD Intrinsic::    (Reserved for future use.)
-* Date Intrinsic::      Get current date as dd-Mon-yy.
-@end ifset
-@ifset familyF90
-* Date_and_Time Intrinsic:: Get the current date and time.
-@end ifset
-@ifset familyF2U
-* DbesJ0 Intrinsic::    Bessel function (archaic).
-* DbesJ1 Intrinsic::    Bessel function (archaic).
-* DbesJN Intrinsic::    Bessel function (archaic).
-* DbesY0 Intrinsic::    Bessel function (archaic).
-* DbesY1 Intrinsic::    Bessel function (archaic).
-* DbesYN Intrinsic::    Bessel function (archaic).
-@end ifset
-@ifset familyF77
-* Dble Intrinsic::      Convert to double precision.
-@end ifset
-@ifset familyVXT
-* DbleQ Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyFVZ
-* DCmplx Intrinsic::    Construct @code{COMPLEX(KIND=2)} value.
-* DConjg Intrinsic::    Complex conjugate (archaic).
-@end ifset
-@ifset familyF77
-* DCos Intrinsic::      Cosine (archaic).
-@end ifset
-@ifset familyVXT
-* DCosD Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DCosH Intrinsic::     Hyperbolic cosine (archaic).
-* DDiM Intrinsic::      Difference magnitude (archaic).
-@end ifset
-@ifset familyF2U
-* DErF Intrinsic::      Error function (archaic).
-* DErFC Intrinsic::     Complementary error function (archaic).
-@end ifset
-@ifset familyF77
-* DExp Intrinsic::      Exponential (archaic).
-@end ifset
-@ifset familyFVZ
-* DFloat Intrinsic::    Conversion (archaic).
-@end ifset
-@ifset familyVXT
-* DFlotI Intrinsic::    (Reserved for future use.)
-* DFlotJ Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* Digits Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DiM Intrinsic::       Difference magnitude (non-negative subtract).
-@end ifset
-@ifset familyFVZ
-* DImag Intrinsic::     Convert/extract imaginary part of complex (archaic).
-@end ifset
-@ifset familyF77
-* DInt Intrinsic::      Truncate to whole number (archaic).
-* DLog Intrinsic::      Natural logarithm (archaic).
-* DLog10 Intrinsic::    Common logarithm (archaic).
-* DMax1 Intrinsic::     Maximum value (archaic).
-* DMin1 Intrinsic::     Minimum value (archaic).
-* DMod Intrinsic::      Remainder (archaic).
-* DNInt Intrinsic::     Round to nearest whole number (archaic).
-@end ifset
-@ifset familyF90
-* Dot_Product Intrinsic:: (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DProd Intrinsic::     Double-precision product.
-@end ifset
-@ifset familyVXT
-* DReal Intrinsic::     Convert value to type @code{REAL(KIND=2)}.
-@end ifset
-@ifset familyF77
-* DSign Intrinsic::     Apply sign to magnitude (archaic).
-* DSin Intrinsic::      Sine (archaic).
-@end ifset
-@ifset familyVXT
-* DSinD Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DSinH Intrinsic::     Hyperbolic sine (archaic).
-* DSqRt Intrinsic::     Square root (archaic).
-* DTan Intrinsic::      Tangent (archaic).
-@end ifset
-@ifset familyVXT
-* DTanD Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* DTanH Intrinsic::     Hyperbolic tangent (archaic).
-@end ifset
-@ifset familyF2U
-* DTime Intrinsic (subroutine):: Get elapsed time since last time.
-@end ifset
-@ifset familyBADU77
-* DTime Intrinsic (function):: Get elapsed time since last time.
-@end ifset
-@ifset familyF90
-* EOShift Intrinsic::   (Reserved for future use.)
-* Epsilon Intrinsic::   (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* ErF Intrinsic::       Error function.
-* ErFC Intrinsic::      Complementary error function.
-* ETime Intrinsic (subroutine):: Get elapsed time for process.
-* ETime Intrinsic (function):: Get elapsed time for process.
-* Exit Intrinsic::      Terminate the program.
-@end ifset
-@ifset familyF77
-* Exp Intrinsic::       Exponential.
-@end ifset
-@ifset familyF90
-* Exponent Intrinsic::  (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* FDate Intrinsic (subroutine):: Get current time as Day Mon dd hh:mm:ss yyyy.
-* FDate Intrinsic (function):: Get current time as Day Mon dd hh:mm:ss yyyy.
-* FGet Intrinsic (subroutine):: Read a character from unit 5 stream-wise.
-@end ifset
-@ifset familyBADU77
-* FGet Intrinsic (function):: Read a character from unit 5 stream-wise.
-@end ifset
-@ifset familyF2U
-* FGetC Intrinsic (subroutine):: Read a character stream-wise.
-@end ifset
-@ifset familyBADU77
-* FGetC Intrinsic (function):: Read a character stream-wise.
-@end ifset
-@ifset familyF77
-* Float Intrinsic::     Conversion (archaic).
-@end ifset
-@ifset familyVXT
-* FloatI Intrinsic::    (Reserved for future use.)
-* FloatJ Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* Floor Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* Flush Intrinsic::     Flush buffered output.
-* FNum Intrinsic::      Get file descriptor from Fortran unit number.
-* FPut Intrinsic (subroutine):: Write a character to unit 6 stream-wise.
-@end ifset
-@ifset familyBADU77
-* FPut Intrinsic (function):: Write a character to unit 6 stream-wise.
-@end ifset
-@ifset familyF2U
-* FPutC Intrinsic (subroutine):: Write a character stream-wise.
-@end ifset
-@ifset familyBADU77
-* FPutC Intrinsic (function):: Write a character stream-wise.
-@end ifset
-@ifset familyF90
-* Fraction Intrinsic::  (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* FSeek Intrinsic::     Position file (low-level).
-* FStat Intrinsic (subroutine):: Get file information.
-* FStat Intrinsic (function):: Get file information.
-* FTell Intrinsic (subroutine):: Get file position (low-level).
-* FTell Intrinsic (function):: Get file position (low-level).
-* GError Intrinsic::    Get error message for last error.
-* GetArg Intrinsic::    Obtain command-line argument.
-* GetCWD Intrinsic (subroutine):: Get current working directory.
-* GetCWD Intrinsic (function):: Get current working directory.
-* GetEnv Intrinsic::    Get environment variable.
-* GetGId Intrinsic::    Get process group id.
-* GetLog Intrinsic::    Get login name.
-* GetPId Intrinsic::    Get process id.
-* GetUId Intrinsic::    Get process user id.
-* GMTime Intrinsic::    Convert time to GMT time info.
-* HostNm Intrinsic (subroutine):: Get host name.
-* HostNm Intrinsic (function):: Get host name.
-@end ifset
-@ifset familyF90
-* Huge Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* IAbs Intrinsic::      Absolute value (archaic).
-@end ifset
-@ifset familyASC
-* IAChar Intrinsic::    ASCII code for character.
-@end ifset
-@ifset familyMIL
-* IAnd Intrinsic::      Boolean AND.
-@end ifset
-@ifset familyF2U
-* IArgC Intrinsic::     Obtain count of command-line arguments.
-@end ifset
-@ifset familyMIL
-* IBClr Intrinsic::     Clear a bit.
-* IBits Intrinsic::     Extract a bit subfield of a variable.
-* IBSet Intrinsic::     Set a bit.
-@end ifset
-@ifset familyF77
-* IChar Intrinsic::     Code for character.
-@end ifset
-@ifset familyF2U
-* IDate Intrinsic (UNIX):: Get local time info.
-@end ifset
-@ifset familyVXT
-* IDate Intrinsic (VXT):: Get local time info (VAX/VMS).
-@end ifset
-@ifset familyF77
-* IDiM Intrinsic::      Difference magnitude (archaic).
-* IDInt Intrinsic::     Convert to @code{INTEGER} value truncated
-                         to whole number (archaic).
-* IDNInt Intrinsic::    Convert to @code{INTEGER} value rounded
-                         to nearest whole number (archaic).
-@end ifset
-@ifset familyMIL
-* IEOr Intrinsic::      Boolean XOR.
-@end ifset
-@ifset familyF2U
-* IErrNo Intrinsic::    Get error number for last error.
-@end ifset
-@ifset familyF77
-* IFix Intrinsic::      Conversion (archaic).
-@end ifset
-@ifset familyVXT
-* IIAbs Intrinsic::     (Reserved for future use.)
-* IIAnd Intrinsic::     (Reserved for future use.)
-* IIBClr Intrinsic::    (Reserved for future use.)
-* IIBits Intrinsic::    (Reserved for future use.)
-* IIBSet Intrinsic::    (Reserved for future use.)
-* IIDiM Intrinsic::     (Reserved for future use.)
-* IIDInt Intrinsic::    (Reserved for future use.)
-* IIDNnt Intrinsic::    (Reserved for future use.)
-* IIEOr Intrinsic::     (Reserved for future use.)
-* IIFix Intrinsic::     (Reserved for future use.)
-* IInt Intrinsic::      (Reserved for future use.)
-* IIOr Intrinsic::      (Reserved for future use.)
-* IIQint Intrinsic::    (Reserved for future use.)
-* IIQNnt Intrinsic::    (Reserved for future use.)
-* IIShftC Intrinsic::   (Reserved for future use.)
-* IISign Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF2C
-* Imag Intrinsic::      Extract imaginary part of complex.
-@end ifset
-@ifset familyGNU
-* ImagPart Intrinsic::  Extract imaginary part of complex.
-@end ifset
-@ifset familyVXT
-* IMax0 Intrinsic::     (Reserved for future use.)
-* IMax1 Intrinsic::     (Reserved for future use.)
-* IMin0 Intrinsic::     (Reserved for future use.)
-* IMin1 Intrinsic::     (Reserved for future use.)
-* IMod Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Index Intrinsic::     Locate a CHARACTER substring.
-@end ifset
-@ifset familyVXT
-* INInt Intrinsic::     (Reserved for future use.)
-* INot Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Int Intrinsic::       Convert to @code{INTEGER} value truncated
-                         to whole number.
-@end ifset
-@ifset familyGNU
-* Int2 Intrinsic::      Convert to @code{INTEGER(KIND=6)} value
-                         truncated to whole number.
-* Int8 Intrinsic::      Convert to @code{INTEGER(KIND=2)} value
-                         truncated to whole number.
-@end ifset
-@ifset familyMIL
-* IOr Intrinsic::       Boolean OR.
-@end ifset
-@ifset familyF2U
-* IRand Intrinsic::     Random number.
-* IsaTty Intrinsic::    Is unit connected to a terminal?
-@end ifset
-@ifset familyMIL
-* IShft Intrinsic::     Logical bit shift.
-* IShftC Intrinsic::    Circular bit shift.
-@end ifset
-@ifset familyF77
-* ISign Intrinsic::     Apply sign to magnitude (archaic).
-@end ifset
-@ifset familyF2U
-* ITime Intrinsic::     Get local time of day.
-@end ifset
-@ifset familyVXT
-* IZExt Intrinsic::     (Reserved for future use.)
-* JIAbs Intrinsic::     (Reserved for future use.)
-* JIAnd Intrinsic::     (Reserved for future use.)
-* JIBClr Intrinsic::    (Reserved for future use.)
-* JIBits Intrinsic::    (Reserved for future use.)
-* JIBSet Intrinsic::    (Reserved for future use.)
-* JIDiM Intrinsic::     (Reserved for future use.)
-* JIDInt Intrinsic::    (Reserved for future use.)
-* JIDNnt Intrinsic::    (Reserved for future use.)
-* JIEOr Intrinsic::     (Reserved for future use.)
-* JIFix Intrinsic::     (Reserved for future use.)
-* JInt Intrinsic::      (Reserved for future use.)
-* JIOr Intrinsic::      (Reserved for future use.)
-* JIQint Intrinsic::    (Reserved for future use.)
-* JIQNnt Intrinsic::    (Reserved for future use.)
-* JIShft Intrinsic::    (Reserved for future use.)
-* JIShftC Intrinsic::   (Reserved for future use.)
-* JISign Intrinsic::    (Reserved for future use.)
-* JMax0 Intrinsic::     (Reserved for future use.)
-* JMax1 Intrinsic::     (Reserved for future use.)
-* JMin0 Intrinsic::     (Reserved for future use.)
-* JMin1 Intrinsic::     (Reserved for future use.)
-* JMod Intrinsic::      (Reserved for future use.)
-* JNInt Intrinsic::     (Reserved for future use.)
-* JNot Intrinsic::      (Reserved for future use.)
-* JZExt Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* Kill Intrinsic (subroutine):: Signal a process.
-@end ifset
-@ifset familyBADU77
-* Kill Intrinsic (function):: Signal a process.
-@end ifset
-@ifset familyF90
-* Kind Intrinsic::      (Reserved for future use.)
-* LBound Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Len Intrinsic::       Length of character entity.
-@end ifset
-@ifset familyF90
-* Len_Trim Intrinsic::  Get last non-blank character in string.
-@end ifset
-@ifset familyF77
-* LGe Intrinsic::       Lexically greater than or equal.
-* LGt Intrinsic::       Lexically greater than.
-@end ifset
-@ifset familyF2U
-* Link Intrinsic (subroutine):: Make hard link in file system.
-@end ifset
-@ifset familyBADU77
-* Link Intrinsic (function):: Make hard link in file system.
-@end ifset
-@ifset familyF77
-* LLe Intrinsic::       Lexically less than or equal.
-* LLt Intrinsic::       Lexically less than.
-@end ifset
-@ifset familyF2U
-* LnBlnk Intrinsic::    Get last non-blank character in string.
-* Loc Intrinsic::       Address of entity in core.
-@end ifset
-@ifset familyF77
-* Log Intrinsic::       Natural logarithm.
-* Log10 Intrinsic::     Common logarithm.
-@end ifset
-@ifset familyF90
-* Logical Intrinsic::   (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* Long Intrinsic::      Conversion to @code{INTEGER(KIND=1)} (archaic).
-@end ifset
-@ifset familyF2C
-* LShift Intrinsic::    Left-shift bits.
-@end ifset
-@ifset familyF2U
-* LStat Intrinsic (subroutine):: Get file information.
-* LStat Intrinsic (function):: Get file information.
-* LTime Intrinsic::     Convert time to local time info.
-@end ifset
-@ifset familyF90
-* MatMul Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Max Intrinsic::       Maximum value.
-* Max0 Intrinsic::      Maximum value (archaic).
-* Max1 Intrinsic::      Maximum value (archaic).
-@end ifset
-@ifset familyF90
-* MaxExponent Intrinsic:: (Reserved for future use.)
-* MaxLoc Intrinsic::    (Reserved for future use.)
-* MaxVal Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* MClock Intrinsic::    Get number of clock ticks for process.
-* MClock8 Intrinsic::   Get number of clock ticks for process.
-@end ifset
-@ifset familyF90
-* Merge Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Min Intrinsic::       Minimum value.
-* Min0 Intrinsic::      Minimum value (archaic).
-* Min1 Intrinsic::      Minimum value (archaic).
-@end ifset
-@ifset familyF90
-* MinExponent Intrinsic:: (Reserved for future use.)
-* MinLoc Intrinsic::    (Reserved for future use.)
-* MinVal Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Mod Intrinsic::       Remainder.
-@end ifset
-@ifset familyF90
-* Modulo Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyMIL
-* MvBits Intrinsic::    Moving a bit field.
-@end ifset
-@ifset familyF90
-* Nearest Intrinsic::   (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* NInt Intrinsic::      Convert to @code{INTEGER} value rounded
-                         to nearest whole number.
-@end ifset
-@ifset familyMIL
-* Not Intrinsic::       Boolean NOT.
-@end ifset
-@ifset familyF2C
-* Or Intrinsic::        Boolean OR.
-@end ifset
-@ifset familyF90
-* Pack Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* PError Intrinsic::    Print error message for last error.
-@end ifset
-@ifset familyF90
-* Precision Intrinsic:: (Reserved for future use.)
-* Present Intrinsic::   (Reserved for future use.)
-* Product Intrinsic::   (Reserved for future use.)
-@end ifset
-@ifset familyVXT
-* QAbs Intrinsic::      (Reserved for future use.)
-* QACos Intrinsic::     (Reserved for future use.)
-* QACosD Intrinsic::    (Reserved for future use.)
-* QASin Intrinsic::     (Reserved for future use.)
-* QASinD Intrinsic::    (Reserved for future use.)
-* QATan Intrinsic::     (Reserved for future use.)
-* QATan2 Intrinsic::    (Reserved for future use.)
-* QATan2D Intrinsic::   (Reserved for future use.)
-* QATanD Intrinsic::    (Reserved for future use.)
-* QCos Intrinsic::      (Reserved for future use.)
-* QCosD Intrinsic::     (Reserved for future use.)
-* QCosH Intrinsic::     (Reserved for future use.)
-* QDiM Intrinsic::      (Reserved for future use.)
-* QExp Intrinsic::      (Reserved for future use.)
-* QExt Intrinsic::      (Reserved for future use.)
-* QExtD Intrinsic::     (Reserved for future use.)
-* QFloat Intrinsic::    (Reserved for future use.)
-* QInt Intrinsic::      (Reserved for future use.)
-* QLog Intrinsic::      (Reserved for future use.)
-* QLog10 Intrinsic::    (Reserved for future use.)
-* QMax1 Intrinsic::     (Reserved for future use.)
-* QMin1 Intrinsic::     (Reserved for future use.)
-* QMod Intrinsic::      (Reserved for future use.)
-* QNInt Intrinsic::     (Reserved for future use.)
-* QSin Intrinsic::      (Reserved for future use.)
-* QSinD Intrinsic::     (Reserved for future use.)
-* QSinH Intrinsic::     (Reserved for future use.)
-* QSqRt Intrinsic::     (Reserved for future use.)
-* QTan Intrinsic::      (Reserved for future use.)
-* QTanD Intrinsic::     (Reserved for future use.)
-* QTanH Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* Radix Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* Rand Intrinsic::      Random number.
-@end ifset
-@ifset familyF90
-* Random_Number Intrinsic:: (Reserved for future use.)
-* Random_Seed Intrinsic:: (Reserved for future use.)
-* Range Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* Real Intrinsic::      Convert value to type @code{REAL(KIND=1)}.
-@end ifset
-@ifset familyGNU
-* RealPart Intrinsic::  Extract real part of complex.
-@end ifset
-@ifset familyF2U
-* Rename Intrinsic (subroutine):: Rename file.
-@end ifset
-@ifset familyBADU77
-* Rename Intrinsic (function):: Rename file.
-@end ifset
-@ifset familyF90
-* Repeat Intrinsic::    (Reserved for future use.)
-* Reshape Intrinsic::   (Reserved for future use.)
-* RRSpacing Intrinsic:: (Reserved for future use.)
-@end ifset
-@ifset familyF2C
-* RShift Intrinsic::    Right-shift bits.
-@end ifset
-@ifset familyF90
-* Scale Intrinsic::     (Reserved for future use.)
-* Scan Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyVXT
-* Secnds Intrinsic::    Get local time offset since midnight.
-@end ifset
-@ifset familyF2U
-* Second Intrinsic (function):: Get CPU time for process in seconds.
-* Second Intrinsic (subroutine):: Get CPU time for process
-                         in seconds.
-@end ifset
-@ifset familyF90
-* Selected_Int_Kind Intrinsic:: (Reserved for future use.)
-* Selected_Real_Kind Intrinsic:: (Reserved for future use.)
-* Set_Exponent Intrinsic:: (Reserved for future use.)
-* Shape Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* Short Intrinsic::     Convert to @code{INTEGER(KIND=6)} value
-                         truncated to whole number.
-@end ifset
-@ifset familyF77
-* Sign Intrinsic::      Apply sign to magnitude.
-@end ifset
-@ifset familyF2U
-* Signal Intrinsic (subroutine):: Muck with signal handling.
-@end ifset
-@ifset familyBADU77
-* Signal Intrinsic (function):: Muck with signal handling.
-@end ifset
-@ifset familyF77
-* Sin Intrinsic::       Sine.
-@end ifset
-@ifset familyVXT
-* SinD Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* SinH Intrinsic::      Hyperbolic sine.
-@end ifset
-@ifset familyF2U
-* Sleep Intrinsic::     Sleep for a specified time.
-@end ifset
-@ifset familyF77
-* Sngl Intrinsic::      Convert (archaic).
-@end ifset
-@ifset familyVXT
-* SnglQ Intrinsic::     (Reserved for future use.)
-@end ifset
-@ifset familyF90
-* Spacing Intrinsic::   (Reserved for future use.)
-* Spread Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* SqRt Intrinsic::      Square root.
-@end ifset
-@ifset familyF2U
-* SRand Intrinsic::     Random seed.
-* Stat Intrinsic (subroutine):: Get file information.
-* Stat Intrinsic (function):: Get file information.
-@end ifset
-@ifset familyF90
-* Sum Intrinsic::       (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* SymLnk Intrinsic (subroutine):: Make symbolic link in file system.
-@end ifset
-@ifset familyBADU77
-* SymLnk Intrinsic (function):: Make symbolic link in file system.
-@end ifset
-@ifset familyF2U
-* System Intrinsic (subroutine):: Invoke shell (system) command.
-@end ifset
-@ifset familyBADU77
-* System Intrinsic (function):: Invoke shell (system) command.
-@end ifset
-@ifset familyF90
-* System_Clock Intrinsic:: Get current system clock value.
-@end ifset
-@ifset familyF77
-* Tan Intrinsic::       Tangent.
-@end ifset
-@ifset familyVXT
-* TanD Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF77
-* TanH Intrinsic::      Hyperbolic tangent.
-@end ifset
-@ifset familyF2U
-* Time Intrinsic (UNIX):: Get current time as time value.
-@end ifset
-@ifset familyVXT
-* Time Intrinsic (VXT):: Get the time as a character value.
-@end ifset
-@ifset familyF2U
-* Time8 Intrinsic::     Get current time as time value.
-@end ifset
-@ifset familyF90
-* Tiny Intrinsic::      (Reserved for future use.)
-* Transfer Intrinsic::  (Reserved for future use.)
-* Transpose Intrinsic:: (Reserved for future use.)
-* Trim Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* TtyNam Intrinsic (subroutine):: Get name of terminal device for unit.
-* TtyNam Intrinsic (function):: Get name of terminal device for unit.
-@end ifset
-@ifset familyF90
-* UBound Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF2U
-* UMask Intrinsic (subroutine):: Set file creation permissions mask.
-@end ifset
-@ifset familyBADU77
-* UMask Intrinsic (function):: Set file creation permissions mask.
-@end ifset
-@ifset familyF2U
-* Unlink Intrinsic (subroutine):: Unlink file.
-@end ifset
-@ifset familyBADU77
-* Unlink Intrinsic (function):: Unlink file.
-@end ifset
-@ifset familyF90
-* Unpack Intrinsic::    (Reserved for future use.)
-* Verify Intrinsic::    (Reserved for future use.)
-@end ifset
-@ifset familyF2C
-* XOr Intrinsic::       Boolean XOR.
-* ZAbs Intrinsic::      Absolute value (archaic).
-* ZCos Intrinsic::      Cosine (archaic).
-* ZExp Intrinsic::      Exponential (archaic).
-@end ifset
-@ifset familyVXT
-* ZExt Intrinsic::      (Reserved for future use.)
-@end ifset
-@ifset familyF2C
-* ZLog Intrinsic::      Natural logarithm (archaic).
-* ZSin Intrinsic::      Sine (archaic).
-* ZSqRt Intrinsic::     Square root (archaic).
-@end ifset
-@end menu
-
-@ifset familyF2U
-@node Abort Intrinsic
-@subsubsection Abort Intrinsic
-@cindex Abort intrinsic
-@cindex intrinsics, Abort
-
-@noindent
-@example
-CALL Abort()
-@end example
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Prints a message and potentially causes a core dump via @code{abort(3)}.
-
-@end ifset
-@ifset familyF77
-@node Abs Intrinsic
-@subsubsection Abs Intrinsic
-@cindex Abs intrinsic
-@cindex intrinsics, Abs
-
-@noindent
-@example
-Abs(@var{A})
-@end example
-
-@noindent
-Abs: @code{INTEGER} or @code{REAL} function.
-The exact type depends on that of argument @var{A}---if @var{A} is
-@code{COMPLEX}, this function's type is @code{REAL}
-with the same @samp{KIND=} value as the type of @var{A}.
-Otherwise, this function's type is the same as that of @var{A}.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the absolute value of @var{A}.
-
-If @var{A} is type @code{COMPLEX}, the absolute
-value is computed as:
-
-@example
-SQRT(REALPART(@var{A})**2+IMAGPART(@var{A})**2)
-@end example
-
-@noindent
-Otherwise, it is computed by negating @var{A} if
-it is negative, or returning @var{A}.
-
-@xref{Sign Intrinsic}, for how to explicitly
-compute the positive or negative form of the absolute
-value of an expression.
-
-@end ifset
-@ifset familyF2U
-@node Access Intrinsic
-@subsubsection Access Intrinsic
-@cindex Access intrinsic
-@cindex intrinsics, Access
-
-@noindent
-@example
-Access(@var{Name}, @var{Mode})
-@end example
-
-@noindent
-Access: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Checks file @var{Name} for accessibility in the mode specified by @var{Mode} and
-returns 0 if the file is accessible in that mode, otherwise an error
-code if the file is inaccessible or @var{Mode} is invalid.
-See @code{access(2)}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{Name}---otherwise,
-trailing blanks in @var{Name} are ignored.
-@var{Mode} may be a concatenation of any of the following characters:
-
-@table @samp
-@item r
-Read permission
-
-@item w
-Write permission
-
-@item x
-Execute permission
-
-@item @kbd{SPC}
-Existence
-@end table
-
-@end ifset
-@ifset familyASC
-@node AChar Intrinsic
-@subsubsection AChar Intrinsic
-@cindex AChar intrinsic
-@cindex intrinsics, AChar
-
-@noindent
-@example
-AChar(@var{I})
-@end example
-
-@noindent
-AChar: @code{CHARACTER*1} function.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{f90}.
-
-@noindent
-Description:
-
-Returns the ASCII character corresponding to the
-code specified by @var{I}.
-
-@xref{IAChar Intrinsic}, for the inverse of this function.
-
-@xref{Char Intrinsic}, for the function corresponding
-to the system's native character set.
-
-@end ifset
-@ifset familyF77
-@node ACos Intrinsic
-@subsubsection ACos Intrinsic
-@cindex ACos intrinsic
-@cindex intrinsics, ACos
-
-@noindent
-@example
-ACos(@var{X})
-@end example
-
-@noindent
-ACos: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the arc-cosine (inverse cosine) of @var{X}
-in radians.
-
-@xref{Cos Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyVXT
-@node ACosD Intrinsic
-@subsubsection ACosD Intrinsic
-@cindex ACosD intrinsic
-@cindex intrinsics, ACosD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL ACosD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node AdjustL Intrinsic
-@subsubsection AdjustL Intrinsic
-@cindex AdjustL intrinsic
-@cindex intrinsics, AdjustL
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL AdjustL} to use this name for an
-external procedure.
-
-@node AdjustR Intrinsic
-@subsubsection AdjustR Intrinsic
-@cindex AdjustR intrinsic
-@cindex intrinsics, AdjustR
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL AdjustR} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node AImag Intrinsic
-@subsubsection AImag Intrinsic
-@cindex AImag intrinsic
-@cindex intrinsics, AImag
-
-@noindent
-@example
-AImag(@var{Z})
-@end example
-
-@noindent
-AImag: @code{REAL} function.
-This intrinsic is valid when argument @var{Z} is
-@code{COMPLEX(KIND=1)}.
-When @var{Z} is any other @code{COMPLEX} type,
-this intrinsic is valid only when used as the argument to
-@code{REAL()}, as explained below.
-
-@noindent
-@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the (possibly converted) imaginary part of @var{Z}.
-
-Use of @code{AIMAG()} with an argument of a type
-other than @code{COMPLEX(KIND=1)} is restricted to the following case:
-
-@example
-REAL(AIMAG(Z))
-@end example
-
-@noindent
-This expression converts the imaginary part of Z to
-@code{REAL(KIND=1)}.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-
-@end ifset
-@ifset familyVXT
-@node AIMax0 Intrinsic
-@subsubsection AIMax0 Intrinsic
-@cindex AIMax0 intrinsic
-@cindex intrinsics, AIMax0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL AIMax0} to use this name for an
-external procedure.
-
-@node AIMin0 Intrinsic
-@subsubsection AIMin0 Intrinsic
-@cindex AIMin0 intrinsic
-@cindex intrinsics, AIMin0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL AIMin0} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node AInt Intrinsic
-@subsubsection AInt Intrinsic
-@cindex AInt intrinsic
-@cindex intrinsics, AInt
-
-@noindent
-@example
-AInt(@var{A})
-@end example
-
-@noindent
-AInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}.
-
-@noindent
-@var{A}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude truncated and its sign preserved.
-(Also called ``truncation towards zero''.)
-
-@xref{ANInt Intrinsic}, for how to round to nearest
-whole number.
-
-@xref{Int Intrinsic}, for how to truncate and then convert
-number to @code{INTEGER}.
-
-@end ifset
-@ifset familyVXT
-@node AJMax0 Intrinsic
-@subsubsection AJMax0 Intrinsic
-@cindex AJMax0 intrinsic
-@cindex intrinsics, AJMax0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL AJMax0} to use this name for an
-external procedure.
-
-@node AJMin0 Intrinsic
-@subsubsection AJMin0 Intrinsic
-@cindex AJMin0 intrinsic
-@cindex intrinsics, AJMin0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL AJMin0} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node Alarm Intrinsic
-@subsubsection Alarm Intrinsic
-@cindex Alarm intrinsic
-@cindex intrinsics, Alarm
-
-@noindent
-@example
-CALL Alarm(@var{Seconds}, @var{Handler}, @var{Status})
-@end example
-
-@noindent
-@var{Seconds}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
-or dummy/global @code{INTEGER(KIND=1)} scalar.
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Causes external subroutine @var{Handler} to be executed after a delay of
-@var{Seconds} seconds by using @code{alarm(1)} to set up a signal and
-@code{signal(2)} to catch it.
-If @var{Status} is supplied, it will be
-returned with the number of seconds remaining until any previously
-scheduled alarm was due to be delivered, or zero if there was no
-previously scheduled alarm.
-@xref{Signal Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node All Intrinsic
-@subsubsection All Intrinsic
-@cindex All intrinsic
-@cindex intrinsics, All
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL All} to use this name for an
-external procedure.
-
-@node Allocated Intrinsic
-@subsubsection Allocated Intrinsic
-@cindex Allocated intrinsic
-@cindex intrinsics, Allocated
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Allocated} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node ALog Intrinsic
-@subsubsection ALog Intrinsic
-@cindex ALog intrinsic
-@cindex intrinsics, ALog
-
-@noindent
-@example
-ALog(@var{X})
-@end example
-
-@noindent
-ALog: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{LOG()} that is specific
-to one type for @var{X}.
-@xref{Log Intrinsic}.
-
-@node ALog10 Intrinsic
-@subsubsection ALog10 Intrinsic
-@cindex ALog10 intrinsic
-@cindex intrinsics, ALog10
-
-@noindent
-@example
-ALog10(@var{X})
-@end example
-
-@noindent
-ALog10: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{LOG10()} that is specific
-to one type for @var{X}.
-@xref{Log10 Intrinsic}.
-
-@node AMax0 Intrinsic
-@subsubsection AMax0 Intrinsic
-@cindex AMax0 intrinsic
-@cindex intrinsics, AMax0
-
-@noindent
-@example
-AMax0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-AMax0: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MAX()} that is specific
-to one type for @var{A} and a different return type.
-@xref{Max Intrinsic}.
-
-@node AMax1 Intrinsic
-@subsubsection AMax1 Intrinsic
-@cindex AMax1 intrinsic
-@cindex intrinsics, AMax1
-
-@noindent
-@example
-AMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-AMax1: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MAX()} that is specific
-to one type for @var{A}.
-@xref{Max Intrinsic}.
-
-@node AMin0 Intrinsic
-@subsubsection AMin0 Intrinsic
-@cindex AMin0 intrinsic
-@cindex intrinsics, AMin0
-
-@noindent
-@example
-AMin0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-AMin0: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MIN()} that is specific
-to one type for @var{A} and a different return type.
-@xref{Min Intrinsic}.
-
-@node AMin1 Intrinsic
-@subsubsection AMin1 Intrinsic
-@cindex AMin1 intrinsic
-@cindex intrinsics, AMin1
-
-@noindent
-@example
-AMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-AMin1: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MIN()} that is specific
-to one type for @var{A}.
-@xref{Min Intrinsic}.
-
-@node AMod Intrinsic
-@subsubsection AMod Intrinsic
-@cindex AMod intrinsic
-@cindex intrinsics, AMod
-
-@noindent
-@example
-AMod(@var{A}, @var{P})
-@end example
-
-@noindent
-AMod: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-@var{P}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MOD()} that is specific
-to one type for @var{A}.
-@xref{Mod Intrinsic}.
-
-@end ifset
-@ifset familyF2C
-@node And Intrinsic
-@subsubsection And Intrinsic
-@cindex And intrinsic
-@cindex intrinsics, And
-
-@noindent
-@example
-And(@var{I}, @var{J})
-@end example
-
-@noindent
-And: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
-
-@noindent
-@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean AND of
-pair of bits in each of @var{I} and @var{J}.
-
-@end ifset
-@ifset familyF77
-@node ANInt Intrinsic
-@subsubsection ANInt Intrinsic
-@cindex ANInt intrinsic
-@cindex intrinsics, ANInt
-
-@noindent
-@example
-ANInt(@var{A})
-@end example
-
-@noindent
-ANInt: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{A}.
-
-@noindent
-@var{A}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude eliminated by rounding to the nearest whole
-number and with its sign preserved.
-
-A fractional portion exactly equal to
-@samp{.5} is rounded to the whole number that
-is larger in magnitude.
-(Also called ``Fortran round''.)
-
-@xref{AInt Intrinsic}, for how to truncate to
-whole number.
-
-@xref{NInt Intrinsic}, for how to round and then convert
-number to @code{INTEGER}.
-
-@end ifset
-@ifset familyF90
-@node Any Intrinsic
-@subsubsection Any Intrinsic
-@cindex Any intrinsic
-@cindex intrinsics, Any
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Any} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node ASin Intrinsic
-@subsubsection ASin Intrinsic
-@cindex ASin intrinsic
-@cindex intrinsics, ASin
-
-@noindent
-@example
-ASin(@var{X})
-@end example
-
-@noindent
-ASin: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the arc-sine (inverse sine) of @var{X}
-in radians.
-
-@xref{Sin Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyVXT
-@node ASinD Intrinsic
-@subsubsection ASinD Intrinsic
-@cindex ASinD intrinsic
-@cindex intrinsics, ASinD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL ASinD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node Associated Intrinsic
-@subsubsection Associated Intrinsic
-@cindex Associated intrinsic
-@cindex intrinsics, Associated
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Associated} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node ATan Intrinsic
-@subsubsection ATan Intrinsic
-@cindex ATan intrinsic
-@cindex intrinsics, ATan
-
-@noindent
-@example
-ATan(@var{X})
-@end example
-
-@noindent
-ATan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the arc-tangent (inverse tangent) of @var{X}
-in radians.
-
-@xref{Tan Intrinsic}, for the inverse of this function.
-
-@node ATan2 Intrinsic
-@subsubsection ATan2 Intrinsic
-@cindex ATan2 intrinsic
-@cindex intrinsics, ATan2
-
-@noindent
-@example
-ATan2(@var{Y}, @var{X})
-@end example
-
-@noindent
-ATan2: @code{REAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{Y}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the arc-tangent (inverse tangent) of the complex
-number (@var{Y}, @var{X}) in radians.
-
-@xref{Tan Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyVXT
-@node ATan2D Intrinsic
-@subsubsection ATan2D Intrinsic
-@cindex ATan2D intrinsic
-@cindex intrinsics, ATan2D
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL ATan2D} to use this name for an
-external procedure.
-
-@node ATanD Intrinsic
-@subsubsection ATanD Intrinsic
-@cindex ATanD intrinsic
-@cindex intrinsics, ATanD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL ATanD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node BesJ0 Intrinsic
-@subsubsection BesJ0 Intrinsic
-@cindex BesJ0 intrinsic
-@cindex intrinsics, BesJ0
-
-@noindent
-@example
-BesJ0(@var{X})
-@end example
-
-@noindent
-BesJ0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Calculates the Bessel function of the first kind of order 0 of @var{X}.
-See @code{bessel(3m)}, on whose implementation the function depends.
-@node BesJ1 Intrinsic
-@subsubsection BesJ1 Intrinsic
-@cindex BesJ1 intrinsic
-@cindex intrinsics, BesJ1
-
-@noindent
-@example
-BesJ1(@var{X})
-@end example
-
-@noindent
-BesJ1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Calculates the Bessel function of the first kind of order 1 of @var{X}.
-See @code{bessel(3m)}, on whose implementation the function depends.
-@node BesJN Intrinsic
-@subsubsection BesJN Intrinsic
-@cindex BesJN intrinsic
-@cindex intrinsics, BesJN
-
-@noindent
-@example
-BesJN(@var{N}, @var{X})
-@end example
-
-@noindent
-BesJN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Calculates the Bessel function of the first kind of order @var{N} of @var{X}.
-See @code{bessel(3m)}, on whose implementation the function depends.
-@node BesY0 Intrinsic
-@subsubsection BesY0 Intrinsic
-@cindex BesY0 intrinsic
-@cindex intrinsics, BesY0
-
-@noindent
-@example
-BesY0(@var{X})
-@end example
-
-@noindent
-BesY0: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Calculates the Bessel function of the second kind of order 0 of @var{X}.
-See @code{bessel(3m)}, on whose implementation the function depends.
-@node BesY1 Intrinsic
-@subsubsection BesY1 Intrinsic
-@cindex BesY1 intrinsic
-@cindex intrinsics, BesY1
-
-@noindent
-@example
-BesY1(@var{X})
-@end example
-
-@noindent
-BesY1: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Calculates the Bessel function of the second kind of order 1 of @var{X}.
-See @code{bessel(3m)}, on whose implementation the function depends.
-@node BesYN Intrinsic
-@subsubsection BesYN Intrinsic
-@cindex BesYN intrinsic
-@cindex intrinsics, BesYN
-
-@noindent
-@example
-BesYN(@var{N}, @var{X})
-@end example
-
-@noindent
-BesYN: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Calculates the Bessel function of the second kind of order @var{N} of @var{X}.
-See @code{bessel(3m)}, on whose implementation the function depends.
-@end ifset
-@ifset familyVXT
-@node BITest Intrinsic
-@subsubsection BITest Intrinsic
-@cindex BITest intrinsic
-@cindex intrinsics, BITest
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL BITest} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node Bit_Size Intrinsic
-@subsubsection Bit_Size Intrinsic
-@cindex Bit_Size intrinsic
-@cindex intrinsics, Bit_Size
-
-@noindent
-@example
-Bit_Size(@var{I})
-@end example
-
-@noindent
-Bit_Size: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar.
-
-@noindent
-Intrinsic groups: @code{f90}.
-
-@noindent
-Description:
-
-Returns the number of bits (integer precision plus sign bit)
-represented by the type for @var{I}.
-
-@xref{BTest Intrinsic}, for how to test the value of a
-bit in a variable or array.
-
-@xref{IBSet Intrinsic}, for how to set a bit in a variable to 1.
-
-@xref{IBClr Intrinsic}, for how to set a bit in a variable to 0.
-
-
-@end ifset
-@ifset familyVXT
-@node BJTest Intrinsic
-@subsubsection BJTest Intrinsic
-@cindex BJTest intrinsic
-@cindex intrinsics, BJTest
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL BJTest} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyMIL
-@node BTest Intrinsic
-@subsubsection BTest Intrinsic
-@cindex BTest intrinsic
-@cindex intrinsics, BTest
-
-@noindent
-@example
-BTest(@var{I}, @var{Pos})
-@end example
-
-@noindent
-BTest: @code{LOGICAL(KIND=1)} function.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns @code{.TRUE.} if bit @var{Pos} in @var{I} is
-1, @code{.FALSE.} otherwise.
-
-(Bit 0 is the low-order (rightmost) bit, adding the value 
-@ifinfo
-2**0,
-@end ifinfo
-@iftex
-@tex
-$2^0$,
-@end tex
-@end iftex
-or 1,
-to the number if set to 1;
-bit 1 is the next-higher-order bit, adding 
-@ifinfo
-2**1,
-@end ifinfo
-@iftex
-@tex
-$2^1$,
-@end tex
-@end iftex
-or 2;
-bit 2 adds 
-@ifinfo
-2**2,
-@end ifinfo
-@iftex
-@tex
-$2^2$,
-@end tex
-@end iftex
-or 4; and so on.)
-
-@xref{Bit_Size Intrinsic}, for how to obtain the number of bits
-in a type.
-The leftmost bit of @var{I} is @samp{BIT_SIZE(@var{I}-1)}.
-
-@end ifset
-@ifset familyF77
-@node CAbs Intrinsic
-@subsubsection CAbs Intrinsic
-@cindex CAbs intrinsic
-@cindex intrinsics, CAbs
-
-@noindent
-@example
-CAbs(@var{A})
-@end example
-
-@noindent
-CAbs: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ABS()} that is specific
-to one type for @var{A}.
-@xref{Abs Intrinsic}.
-
-@node CCos Intrinsic
-@subsubsection CCos Intrinsic
-@cindex CCos intrinsic
-@cindex intrinsics, CCos
-
-@noindent
-@example
-CCos(@var{X})
-@end example
-
-@noindent
-CCos: @code{COMPLEX(KIND=1)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{COS()} that is specific
-to one type for @var{X}.
-@xref{Cos Intrinsic}.
-
-@end ifset
-@ifset familyFVZ
-@node CDAbs Intrinsic
-@subsubsection CDAbs Intrinsic
-@cindex CDAbs intrinsic
-@cindex intrinsics, CDAbs
-
-@noindent
-@example
-CDAbs(@var{A})
-@end example
-
-@noindent
-CDAbs: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{ABS()} that is specific
-to one type for @var{A}.
-@xref{Abs Intrinsic}.
-
-@node CDCos Intrinsic
-@subsubsection CDCos Intrinsic
-@cindex CDCos intrinsic
-@cindex intrinsics, CDCos
-
-@noindent
-@example
-CDCos(@var{X})
-@end example
-
-@noindent
-CDCos: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{COS()} that is specific
-to one type for @var{X}.
-@xref{Cos Intrinsic}.
-
-@node CDExp Intrinsic
-@subsubsection CDExp Intrinsic
-@cindex CDExp intrinsic
-@cindex intrinsics, CDExp
-
-@noindent
-@example
-CDExp(@var{X})
-@end example
-
-@noindent
-CDExp: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{EXP()} that is specific
-to one type for @var{X}.
-@xref{Exp Intrinsic}.
-
-@node CDLog Intrinsic
-@subsubsection CDLog Intrinsic
-@cindex CDLog intrinsic
-@cindex intrinsics, CDLog
-
-@noindent
-@example
-CDLog(@var{X})
-@end example
-
-@noindent
-CDLog: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{LOG()} that is specific
-to one type for @var{X}.
-@xref{Log Intrinsic}.
-
-@node CDSin Intrinsic
-@subsubsection CDSin Intrinsic
-@cindex CDSin intrinsic
-@cindex intrinsics, CDSin
-
-@noindent
-@example
-CDSin(@var{X})
-@end example
-
-@noindent
-CDSin: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{SIN()} that is specific
-to one type for @var{X}.
-@xref{Sin Intrinsic}.
-
-@node CDSqRt Intrinsic
-@subsubsection CDSqRt Intrinsic
-@cindex CDSqRt intrinsic
-@cindex intrinsics, CDSqRt
-
-@noindent
-@example
-CDSqRt(@var{X})
-@end example
-
-@noindent
-CDSqRt: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{SQRT()} that is specific
-to one type for @var{X}.
-@xref{SqRt Intrinsic}.
-
-@end ifset
-@ifset familyF90
-@node Ceiling Intrinsic
-@subsubsection Ceiling Intrinsic
-@cindex Ceiling intrinsic
-@cindex intrinsics, Ceiling
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Ceiling} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node CExp Intrinsic
-@subsubsection CExp Intrinsic
-@cindex CExp intrinsic
-@cindex intrinsics, CExp
-
-@noindent
-@example
-CExp(@var{X})
-@end example
-
-@noindent
-CExp: @code{COMPLEX(KIND=1)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{EXP()} that is specific
-to one type for @var{X}.
-@xref{Exp Intrinsic}.
-
-@node Char Intrinsic
-@subsubsection Char Intrinsic
-@cindex Char intrinsic
-@cindex intrinsics, Char
-
-@noindent
-@example
-Char(@var{I})
-@end example
-
-@noindent
-Char: @code{CHARACTER*1} function.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the character corresponding to the
-code specified by @var{I}, using the system's
-native character set.
-
-Because the system's native character set is used,
-the correspondence between character and their codes
-is not necessarily the same between GNU Fortran
-implementations.
-
-Note that no intrinsic exists to convert a numerical
-value to a printable character string.
-For example, there is no intrinsic that, given
-an @code{INTEGER} or @code{REAL} argument with the
-value @samp{154}, returns the @code{CHARACTER}
-result @samp{'154'}.
-
-Instead, you can use internal-file I/O to do this kind
-of conversion.
-For example:
-
-@smallexample
-INTEGER VALUE
-CHARACTER*10 STRING
-VALUE = 154
-WRITE (STRING, '(I10)'), VALUE
-PRINT *, STRING
-END
-@end smallexample
-
-The above program, when run, prints:
-
-@smallexample
-        154
-@end smallexample
-
-@xref{IChar Intrinsic}, for the inverse of the @code{CHAR} function.
-
-@xref{AChar Intrinsic}, for the function corresponding
-to the ASCII character set.
-
-@end ifset
-@ifset familyF2U
-@node ChDir Intrinsic (subroutine)
-@subsubsection ChDir Intrinsic (subroutine)
-@cindex ChDir intrinsic
-@cindex intrinsics, ChDir
-
-@noindent
-@example
-CALL ChDir(@var{Dir}, @var{Status})
-@end example
-
-@noindent
-@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sets the current working directory to be @var{Dir}.
-If the @var{Status} argument is supplied, it contains 0
-on success or a nonzero error code otherwise upon return.
-See @code{chdir(3)}.
-
-@emph{Caution:} Using this routine during I/O to a unit connected with a
-non-absolute file name can cause subsequent I/O on such a unit to fail
-because the I/O library might reopen files by name.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{ChDir Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node ChDir Intrinsic (function)
-@subsubsection ChDir Intrinsic (function)
-@cindex ChDir intrinsic
-@cindex intrinsics, ChDir
-
-@noindent
-@example
-ChDir(@var{Dir})
-@end example
-
-@noindent
-ChDir: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Dir}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Sets the current working directory to be @var{Dir}.
-Returns 0 on success or a nonzero error code.
-See @code{chdir(3)}.
-
-@emph{Caution:} Using this routine during I/O to a unit connected with a
-non-absolute file name can cause subsequent I/O on such a unit to fail
-because the I/O library might reopen files by name.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{ChDir Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF2U
-@node ChMod Intrinsic (subroutine)
-@subsubsection ChMod Intrinsic (subroutine)
-@cindex ChMod intrinsic
-@cindex intrinsics, ChMod
-
-@noindent
-@example
-CALL ChMod(@var{Name}, @var{Mode}, @var{Status})
-@end example
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Changes the access mode of file @var{Name} according to the
-specification @var{Mode}, which is given in the format of
-@code{chmod(1)}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{Name}---otherwise,
-trailing blanks in @var{Name} are ignored.
-Currently, @var{Name} must not contain the single quote
-character.
-
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Note that this currently works
-by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
-the library was configured) and so might fail in some circumstances and
-will, anyway, be slow.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{ChMod Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node ChMod Intrinsic (function)
-@subsubsection ChMod Intrinsic (function)
-@cindex ChMod intrinsic
-@cindex intrinsics, ChMod
-
-@noindent
-@example
-ChMod(@var{Name}, @var{Mode})
-@end example
-
-@noindent
-ChMod: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Mode}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Changes the access mode of file @var{Name} according to the
-specification @var{Mode}, which is given in the format of
-@code{chmod(1)}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{Name}---otherwise,
-trailing blanks in @var{Name} are ignored.
-Currently, @var{Name} must not contain the single quote
-character.
-
-Returns 0 on success or a nonzero error code otherwise.
-
-Note that this currently works
-by actually invoking @code{/bin/chmod} (or the @code{chmod} found when
-the library was configured) and so might fail in some circumstances and
-will, anyway, be slow.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{ChMod Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF77
-@node CLog Intrinsic
-@subsubsection CLog Intrinsic
-@cindex CLog intrinsic
-@cindex intrinsics, CLog
-
-@noindent
-@example
-CLog(@var{X})
-@end example
-
-@noindent
-CLog: @code{COMPLEX(KIND=1)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{LOG()} that is specific
-to one type for @var{X}.
-@xref{Log Intrinsic}.
-
-@node Cmplx Intrinsic
-@subsubsection Cmplx Intrinsic
-@cindex Cmplx intrinsic
-@cindex intrinsics, Cmplx
-
-@noindent
-@example
-Cmplx(@var{X}, @var{Y})
-@end example
-
-@noindent
-Cmplx: @code{COMPLEX(KIND=1)} function.
-
-@noindent
-@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-If @var{X} is not type @code{COMPLEX},
-constructs a value of type @code{COMPLEX(KIND=1)} from the
-real and imaginary values specified by @var{X} and
-@var{Y}, respectively.
-If @var{Y} is omitted, @samp{0.} is assumed.
-
-If @var{X} is type @code{COMPLEX},
-converts it to type @code{COMPLEX(KIND=1)}.
-
-@xref{Complex Intrinsic}, for information on easily constructing
-a @code{COMPLEX} value of arbitrary precision from @code{REAL}
-arguments.
-
-@end ifset
-@ifset familyGNU
-@node Complex Intrinsic
-@subsubsection Complex Intrinsic
-@cindex Complex intrinsic
-@cindex intrinsics, Complex
-
-@noindent
-@example
-Complex(@var{Real}, @var{Imag})
-@end example
-
-@noindent
-Complex: @code{COMPLEX} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{Real}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-@var{Imag}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{gnu}.
-
-@noindent
-Description:
-
-Returns a @code{COMPLEX} value that has @samp{Real} and @samp{Imag} as its
-real and imaginary parts, respectively.
-
-If @var{Real} and @var{Imag} are the same type, and that type is not
-@code{INTEGER}, no data conversion is performed, and the type of
-the resulting value has the same kind value as the types
-of @var{Real} and @var{Imag}.
-
-If @var{Real} and @var{Imag} are not the same type, the usual type-promotion
-rules are applied to both, converting either or both to the
-appropriate @code{REAL} type.
-The type of the resulting value has the same kind value as the
-type to which both @var{Real} and @var{Imag} were converted, in this case.
-
-If @var{Real} and @var{Imag} are both @code{INTEGER}, they are both converted
-to @code{REAL(KIND=1)}, and the result of the @code{COMPLEX()}
-invocation is type @code{COMPLEX(KIND=1)}.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is too hairy to describe here, but it is important to
-note that @samp{CMPLX(D1,D2)} returns a @code{COMPLEX(KIND=1)}
-result even if @samp{D1} and @samp{D2} are type @code{REAL(KIND=2)}.
-Hence the availability of @code{COMPLEX()} in GNU Fortran.
-
-@end ifset
-@ifset familyF77
-@node Conjg Intrinsic
-@subsubsection Conjg Intrinsic
-@cindex Conjg intrinsic
-@cindex intrinsics, Conjg
-
-@noindent
-@example
-Conjg(@var{Z})
-@end example
-
-@noindent
-Conjg: @code{COMPLEX} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
-
-@noindent
-@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the complex conjugate:
-
-@example
-COMPLEX(REALPART(@var{Z}), -IMAGPART(@var{Z}))
-@end example
-
-@node Cos Intrinsic
-@subsubsection Cos Intrinsic
-@cindex Cos intrinsic
-@cindex intrinsics, Cos
-
-@noindent
-@example
-Cos(@var{X})
-@end example
-
-@noindent
-Cos: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the cosine of @var{X}, an angle measured
-in radians.
-
-@xref{ACos Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyVXT
-@node CosD Intrinsic
-@subsubsection CosD Intrinsic
-@cindex CosD intrinsic
-@cindex intrinsics, CosD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL CosD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node CosH Intrinsic
-@subsubsection CosH Intrinsic
-@cindex CosH intrinsic
-@cindex intrinsics, CosH
-
-@noindent
-@example
-CosH(@var{X})
-@end example
-
-@noindent
-CosH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the hyperbolic cosine of @var{X}.
-
-@end ifset
-@ifset familyF90
-@node Count Intrinsic
-@subsubsection Count Intrinsic
-@cindex Count intrinsic
-@cindex intrinsics, Count
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Count} to use this name for an
-external procedure.
-
-@node CPU_Time Intrinsic
-@subsubsection CPU_Time Intrinsic
-@cindex CPU_Time intrinsic
-@cindex intrinsics, CPU_Time
-
-@noindent
-@example
-CALL CPU_Time(@var{Seconds})
-@end example
-
-@noindent
-@var{Seconds}: @code{REAL}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{f90}.
-
-@noindent
-Description:
-
-Returns in @var{Seconds} the current value of the system time.
-This implementation of the Fortran 95 intrinsic is just an alias for
-@code{second} @xref{Second Intrinsic (subroutine)}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-@node CShift Intrinsic
-@subsubsection CShift Intrinsic
-@cindex CShift intrinsic
-@cindex intrinsics, CShift
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL CShift} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node CSin Intrinsic
-@subsubsection CSin Intrinsic
-@cindex CSin intrinsic
-@cindex intrinsics, CSin
-
-@noindent
-@example
-CSin(@var{X})
-@end example
-
-@noindent
-CSin: @code{COMPLEX(KIND=1)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SIN()} that is specific
-to one type for @var{X}.
-@xref{Sin Intrinsic}.
-
-@node CSqRt Intrinsic
-@subsubsection CSqRt Intrinsic
-@cindex CSqRt intrinsic
-@cindex intrinsics, CSqRt
-
-@noindent
-@example
-CSqRt(@var{X})
-@end example
-
-@noindent
-CSqRt: @code{COMPLEX(KIND=1)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SQRT()} that is specific
-to one type for @var{X}.
-@xref{SqRt Intrinsic}.
-
-@end ifset
-@ifset familyF2U
-@node CTime Intrinsic (subroutine)
-@subsubsection CTime Intrinsic (subroutine)
-@cindex CTime intrinsic
-@cindex intrinsics, CTime
-
-@noindent
-@example
-CALL CTime(@var{STime}, @var{Result})
-@end example
-
-@noindent
-@var{STime}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Result}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Converts @var{STime}, a system time value, such as returned by
-@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
-and returns that string in @var{Result}.
-
-@xref{Time8 Intrinsic}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{CTime Intrinsic (function)}.
-
-@node CTime Intrinsic (function)
-@subsubsection CTime Intrinsic (function)
-@cindex CTime intrinsic
-@cindex intrinsics, CTime
-
-@noindent
-@example
-CTime(@var{STime})
-@end example
-
-@noindent
-CTime: @code{CHARACTER*(*)} function.
-
-@noindent
-@var{STime}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Converts @var{STime}, a system time value, such as returned by
-@code{TIME8()}, to a string of the form @samp{Sat Aug 19 18:13:14 1995},
-and returns that string as the function value.
-
-@xref{Time8 Intrinsic}.
-
-For information on other intrinsics with the same name:
-@xref{CTime Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF77
-@node DAbs Intrinsic
-@subsubsection DAbs Intrinsic
-@cindex DAbs intrinsic
-@cindex intrinsics, DAbs
-
-@noindent
-@example
-DAbs(@var{A})
-@end example
-
-@noindent
-DAbs: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ABS()} that is specific
-to one type for @var{A}.
-@xref{Abs Intrinsic}.
-
-@node DACos Intrinsic
-@subsubsection DACos Intrinsic
-@cindex DACos intrinsic
-@cindex intrinsics, DACos
-
-@noindent
-@example
-DACos(@var{X})
-@end example
-
-@noindent
-DACos: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ACOS()} that is specific
-to one type for @var{X}.
-@xref{ACos Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DACosD Intrinsic
-@subsubsection DACosD Intrinsic
-@cindex DACosD intrinsic
-@cindex intrinsics, DACosD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DACosD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DASin Intrinsic
-@subsubsection DASin Intrinsic
-@cindex DASin intrinsic
-@cindex intrinsics, DASin
-
-@noindent
-@example
-DASin(@var{X})
-@end example
-
-@noindent
-DASin: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ASIN()} that is specific
-to one type for @var{X}.
-@xref{ASin Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DASinD Intrinsic
-@subsubsection DASinD Intrinsic
-@cindex DASinD intrinsic
-@cindex intrinsics, DASinD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DASinD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DATan Intrinsic
-@subsubsection DATan Intrinsic
-@cindex DATan intrinsic
-@cindex intrinsics, DATan
-
-@noindent
-@example
-DATan(@var{X})
-@end example
-
-@noindent
-DATan: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ATAN()} that is specific
-to one type for @var{X}.
-@xref{ATan Intrinsic}.
-
-@node DATan2 Intrinsic
-@subsubsection DATan2 Intrinsic
-@cindex DATan2 intrinsic
-@cindex intrinsics, DATan2
-
-@noindent
-@example
-DATan2(@var{Y}, @var{X})
-@end example
-
-@noindent
-DATan2: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ATAN2()} that is specific
-to one type for @var{Y} and @var{X}.
-@xref{ATan2 Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DATan2D Intrinsic
-@subsubsection DATan2D Intrinsic
-@cindex DATan2D intrinsic
-@cindex intrinsics, DATan2D
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DATan2D} to use this name for an
-external procedure.
-
-@node DATanD Intrinsic
-@subsubsection DATanD Intrinsic
-@cindex DATanD intrinsic
-@cindex intrinsics, DATanD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DATanD} to use this name for an
-external procedure.
-
-@node Date Intrinsic
-@subsubsection Date Intrinsic
-@cindex Date intrinsic
-@cindex intrinsics, Date
-
-@noindent
-@example
-CALL Date(@var{Date})
-@end example
-
-@noindent
-@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{vxt}.
-
-@noindent
-Description:
-
-Returns @var{Date} in the form @samp{@var{dd}-@var{mmm}-@var{yy}},
-representing the numeric day of the month @var{dd}, a three-character
-abbreviation of the month name @var{mmm} and the last two digits of
-the year @var{yy}, e.g.@: @samp{25-Nov-96}.
-
-@cindex Y2K compliance
-@cindex Year 2000 compliance
-This intrinsic is not recommended, due to the year 2000 approaching.
-Therefore, programs making use of this intrinsic
-might not be Year 2000 (Y2K) compliant.
-@xref{CTime Intrinsic (subroutine)}, for information on obtaining more digits
-for the current (or any) date.
-
-@end ifset
-@ifset familyF90
-@node Date_and_Time Intrinsic
-@subsubsection Date_and_Time Intrinsic
-@cindex Date_and_Time intrinsic
-@cindex intrinsics, Date_and_Time
-
-@noindent
-@example
-CALL Date_and_Time(@var{Date}, @var{Time}, @var{Zone}, @var{Values})
-@end example
-
-@noindent
-@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-@var{Time}: @code{CHARACTER}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-@var{Zone}: @code{CHARACTER}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-@var{Values}: @code{INTEGER(KIND=1)}; OPTIONAL; DIMENSION(8); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{f90}.
-
-@noindent
-Description:
-
-Returns:
-@table @var
-@item Date
-The date in the form @var{ccyymmdd}: century, year, month and day;
-@item Time
-The time in the form @samp{@var{hhmmss.ss}}: hours, minutes, seconds
-and milliseconds;
-@item Zone
-The difference between local time and UTC (GMT) in the form @var{Shhmm}:
-sign, hours and minutes, e.g.@: @samp{-0500} (winter in New York);
-@item Values
-The year, month of the year, day of the month, time difference in
-minutes from UTC, hour of the day, minutes of the hour, seconds
-of the minute, and milliseconds
-of the second in successive values of the array.
-@end table
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-On systems where a millisecond timer isn't available, the millisecond
-value is returned as zero.
-
-@end ifset
-@ifset familyF2U
-@node DbesJ0 Intrinsic
-@subsubsection DbesJ0 Intrinsic
-@cindex DbesJ0 intrinsic
-@cindex intrinsics, DbesJ0
-
-@noindent
-@example
-DbesJ0(@var{X})
-@end example
-
-@noindent
-DbesJ0: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{BESJ0()} that is specific
-to one type for @var{X}.
-@xref{BesJ0 Intrinsic}.
-
-@node DbesJ1 Intrinsic
-@subsubsection DbesJ1 Intrinsic
-@cindex DbesJ1 intrinsic
-@cindex intrinsics, DbesJ1
-
-@noindent
-@example
-DbesJ1(@var{X})
-@end example
-
-@noindent
-DbesJ1: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{BESJ1()} that is specific
-to one type for @var{X}.
-@xref{BesJ1 Intrinsic}.
-
-@node DbesJN Intrinsic
-@subsubsection DbesJN Intrinsic
-@cindex DbesJN intrinsic
-@cindex intrinsics, DbesJN
-
-@noindent
-@example
-DbesJN(@var{N}, @var{X})
-@end example
-
-@noindent
-DbesJN: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{BESJN()} that is specific
-to one type for @var{X}.
-@xref{BesJN Intrinsic}.
-
-@node DbesY0 Intrinsic
-@subsubsection DbesY0 Intrinsic
-@cindex DbesY0 intrinsic
-@cindex intrinsics, DbesY0
-
-@noindent
-@example
-DbesY0(@var{X})
-@end example
-
-@noindent
-DbesY0: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{BESY0()} that is specific
-to one type for @var{X}.
-@xref{BesY0 Intrinsic}.
-
-@node DbesY1 Intrinsic
-@subsubsection DbesY1 Intrinsic
-@cindex DbesY1 intrinsic
-@cindex intrinsics, DbesY1
-
-@noindent
-@example
-DbesY1(@var{X})
-@end example
-
-@noindent
-DbesY1: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{BESY1()} that is specific
-to one type for @var{X}.
-@xref{BesY1 Intrinsic}.
-
-@node DbesYN Intrinsic
-@subsubsection DbesYN Intrinsic
-@cindex DbesYN intrinsic
-@cindex intrinsics, DbesYN
-
-@noindent
-@example
-DbesYN(@var{N}, @var{X})
-@end example
-
-@noindent
-DbesYN: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{N}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{BESYN()} that is specific
-to one type for @var{X}.
-@xref{BesYN Intrinsic}.
-
-@end ifset
-@ifset familyF77
-@node Dble Intrinsic
-@subsubsection Dble Intrinsic
-@cindex Dble intrinsic
-@cindex intrinsics, Dble
-
-@noindent
-@example
-Dble(@var{A})
-@end example
-
-@noindent
-Dble: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @var{A} converted to double precision
-(@code{REAL(KIND=2)}).
-If @var{A} is @code{COMPLEX}, the real part of
-@var{A} is used for the conversion
-and the imaginary part disregarded.
-
-@xref{Sngl Intrinsic}, for the function that converts
-to single precision.
-
-@xref{Int Intrinsic}, for the function that converts
-to @code{INTEGER}.
-
-@xref{Complex Intrinsic}, for the function that converts
-to @code{COMPLEX}.
-
-@end ifset
-@ifset familyVXT
-@node DbleQ Intrinsic
-@subsubsection DbleQ Intrinsic
-@cindex DbleQ intrinsic
-@cindex intrinsics, DbleQ
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DbleQ} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyFVZ
-@node DCmplx Intrinsic
-@subsubsection DCmplx Intrinsic
-@cindex DCmplx intrinsic
-@cindex intrinsics, DCmplx
-
-@noindent
-@example
-DCmplx(@var{X}, @var{Y})
-@end example
-
-@noindent
-DCmplx: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-@var{Y}: @code{INTEGER} or @code{REAL}; OPTIONAL (must be omitted if @var{X} is @code{COMPLEX}); scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-If @var{X} is not type @code{COMPLEX},
-constructs a value of type @code{COMPLEX(KIND=2)} from the
-real and imaginary values specified by @var{X} and
-@var{Y}, respectively.
-If @var{Y} is omitted, @samp{0D0} is assumed.
-
-If @var{X} is type @code{COMPLEX},
-converts it to type @code{COMPLEX(KIND=2)}.
-
-Although this intrinsic is not standard Fortran,
-it is a popular extension offered by many compilers
-that support @code{DOUBLE COMPLEX}, since it offers
-the easiest way to convert to @code{DOUBLE COMPLEX}
-without using Fortran 90 features (such as the @samp{KIND=}
-argument to the @code{CMPLX()} intrinsic).
-
-(@samp{CMPLX(0D0, 0D0)} returns a single-precision
-@code{COMPLEX} result, as required by standard FORTRAN 77.
-That's why so many compilers provide @code{DCMPLX()}, since
-@samp{DCMPLX(0D0, 0D0)} returns a @code{DOUBLE COMPLEX}
-result.
-Still, @code{DCMPLX()} converts even @code{REAL*16} arguments
-to their @code{REAL*8} equivalents in most dialects of
-Fortran, so neither it nor @code{CMPLX()} allow easy
-construction of arbitrary-precision values without
-potentially forcing a conversion involving extending or
-reducing precision.
-GNU Fortran provides such an intrinsic, called @code{COMPLEX()}.)
-
-@xref{Complex Intrinsic}, for information on easily constructing
-a @code{COMPLEX} value of arbitrary precision from @code{REAL}
-arguments.
-
-@node DConjg Intrinsic
-@subsubsection DConjg Intrinsic
-@cindex DConjg intrinsic
-@cindex intrinsics, DConjg
-
-@noindent
-@example
-DConjg(@var{Z})
-@end example
-
-@noindent
-DConjg: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{CONJG()} that is specific
-to one type for @var{Z}.
-@xref{Conjg Intrinsic}.
-
-@end ifset
-@ifset familyF77
-@node DCos Intrinsic
-@subsubsection DCos Intrinsic
-@cindex DCos intrinsic
-@cindex intrinsics, DCos
-
-@noindent
-@example
-DCos(@var{X})
-@end example
-
-@noindent
-DCos: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{COS()} that is specific
-to one type for @var{X}.
-@xref{Cos Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DCosD Intrinsic
-@subsubsection DCosD Intrinsic
-@cindex DCosD intrinsic
-@cindex intrinsics, DCosD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DCosD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DCosH Intrinsic
-@subsubsection DCosH Intrinsic
-@cindex DCosH intrinsic
-@cindex intrinsics, DCosH
-
-@noindent
-@example
-DCosH(@var{X})
-@end example
-
-@noindent
-DCosH: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{COSH()} that is specific
-to one type for @var{X}.
-@xref{CosH Intrinsic}.
-
-@node DDiM Intrinsic
-@subsubsection DDiM Intrinsic
-@cindex DDiM intrinsic
-@cindex intrinsics, DDiM
-
-@noindent
-@example
-DDiM(@var{X}, @var{Y})
-@end example
-
-@noindent
-DDiM: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-@var{Y}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{DIM()} that is specific
-to one type for @var{X} and @var{Y}.
-@xref{DiM Intrinsic}.
-
-@end ifset
-@ifset familyF2U
-@node DErF Intrinsic
-@subsubsection DErF Intrinsic
-@cindex DErF intrinsic
-@cindex intrinsics, DErF
-
-@noindent
-@example
-DErF(@var{X})
-@end example
-
-@noindent
-DErF: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{ERF()} that is specific
-to one type for @var{X}.
-@xref{ErF Intrinsic}.
-
-@node DErFC Intrinsic
-@subsubsection DErFC Intrinsic
-@cindex DErFC intrinsic
-@cindex intrinsics, DErFC
-
-@noindent
-@example
-DErFC(@var{X})
-@end example
-
-@noindent
-DErFC: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{ERFC()} that is specific
-to one type for @var{X}.
-@xref{ErFC Intrinsic}.
-
-@end ifset
-@ifset familyF77
-@node DExp Intrinsic
-@subsubsection DExp Intrinsic
-@cindex DExp intrinsic
-@cindex intrinsics, DExp
-
-@noindent
-@example
-DExp(@var{X})
-@end example
-
-@noindent
-DExp: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{EXP()} that is specific
-to one type for @var{X}.
-@xref{Exp Intrinsic}.
-
-@end ifset
-@ifset familyFVZ
-@node DFloat Intrinsic
-@subsubsection DFloat Intrinsic
-@cindex DFloat intrinsic
-@cindex intrinsics, DFloat
-
-@noindent
-@example
-DFloat(@var{A})
-@end example
-
-@noindent
-DFloat: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{REAL()} that is specific
-to one type for @var{A}.
-@xref{Real Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DFlotI Intrinsic
-@subsubsection DFlotI Intrinsic
-@cindex DFlotI intrinsic
-@cindex intrinsics, DFlotI
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DFlotI} to use this name for an
-external procedure.
-
-@node DFlotJ Intrinsic
-@subsubsection DFlotJ Intrinsic
-@cindex DFlotJ intrinsic
-@cindex intrinsics, DFlotJ
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DFlotJ} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node Digits Intrinsic
-@subsubsection Digits Intrinsic
-@cindex Digits intrinsic
-@cindex intrinsics, Digits
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Digits} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DiM Intrinsic
-@subsubsection DiM Intrinsic
-@cindex DiM intrinsic
-@cindex intrinsics, DiM
-
-@noindent
-@example
-DiM(@var{X}, @var{Y})
-@end example
-
-@noindent
-DiM: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{X}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-@var{Y}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{@var{X}-@var{Y}} if @var{X} is greater than
-@var{Y}; otherwise returns zero.
-
-@end ifset
-@ifset familyFVZ
-@node DImag Intrinsic
-@subsubsection DImag Intrinsic
-@cindex DImag intrinsic
-@cindex intrinsics, DImag
-
-@noindent
-@example
-DImag(@var{Z})
-@end example
-
-@noindent
-DImag: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{Z}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{vxt}.
-
-@noindent
-Description:
-
-Archaic form of @code{AIMAG()} that is specific
-to one type for @var{Z}.
-@xref{AImag Intrinsic}.
-
-@end ifset
-@ifset familyF77
-@node DInt Intrinsic
-@subsubsection DInt Intrinsic
-@cindex DInt intrinsic
-@cindex intrinsics, DInt
-
-@noindent
-@example
-DInt(@var{A})
-@end example
-
-@noindent
-DInt: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{AINT()} that is specific
-to one type for @var{A}.
-@xref{AInt Intrinsic}.
-
-@node DLog Intrinsic
-@subsubsection DLog Intrinsic
-@cindex DLog intrinsic
-@cindex intrinsics, DLog
-
-@noindent
-@example
-DLog(@var{X})
-@end example
-
-@noindent
-DLog: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{LOG()} that is specific
-to one type for @var{X}.
-@xref{Log Intrinsic}.
-
-@node DLog10 Intrinsic
-@subsubsection DLog10 Intrinsic
-@cindex DLog10 intrinsic
-@cindex intrinsics, DLog10
-
-@noindent
-@example
-DLog10(@var{X})
-@end example
-
-@noindent
-DLog10: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{LOG10()} that is specific
-to one type for @var{X}.
-@xref{Log10 Intrinsic}.
-
-@node DMax1 Intrinsic
-@subsubsection DMax1 Intrinsic
-@cindex DMax1 intrinsic
-@cindex intrinsics, DMax1
-
-@noindent
-@example
-DMax1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-DMax1: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MAX()} that is specific
-to one type for @var{A}.
-@xref{Max Intrinsic}.
-
-@node DMin1 Intrinsic
-@subsubsection DMin1 Intrinsic
-@cindex DMin1 intrinsic
-@cindex intrinsics, DMin1
-
-@noindent
-@example
-DMin1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-DMin1: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MIN()} that is specific
-to one type for @var{A}.
-@xref{Min Intrinsic}.
-
-@node DMod Intrinsic
-@subsubsection DMod Intrinsic
-@cindex DMod intrinsic
-@cindex intrinsics, DMod
-
-@noindent
-@example
-DMod(@var{A}, @var{P})
-@end example
-
-@noindent
-DMod: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-@var{P}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MOD()} that is specific
-to one type for @var{A}.
-@xref{Mod Intrinsic}.
-
-@node DNInt Intrinsic
-@subsubsection DNInt Intrinsic
-@cindex DNInt intrinsic
-@cindex intrinsics, DNInt
-
-@noindent
-@example
-DNInt(@var{A})
-@end example
-
-@noindent
-DNInt: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ANINT()} that is specific
-to one type for @var{A}.
-@xref{ANInt Intrinsic}.
-
-@end ifset
-@ifset familyF90
-@node Dot_Product Intrinsic
-@subsubsection Dot_Product Intrinsic
-@cindex Dot_Product intrinsic
-@cindex intrinsics, Dot_Product
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Dot_Product} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DProd Intrinsic
-@subsubsection DProd Intrinsic
-@cindex DProd intrinsic
-@cindex intrinsics, DProd
-
-@noindent
-@example
-DProd(@var{X}, @var{Y})
-@end example
-
-@noindent
-DProd: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-@var{Y}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{DBLE(@var{X})*DBLE(@var{Y})}.
-
-@end ifset
-@ifset familyVXT
-@node DReal Intrinsic
-@subsubsection DReal Intrinsic
-@cindex DReal intrinsic
-@cindex intrinsics, DReal
-
-@noindent
-@example
-DReal(@var{A})
-@end example
-
-@noindent
-DReal: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{vxt}.
-
-@noindent
-Description:
-
-Converts @var{A} to @code{REAL(KIND=2)}.
-
-If @var{A} is type @code{COMPLEX}, its real part
-is converted (if necessary) to @code{REAL(KIND=2)},
-and its imaginary part is disregarded.
-
-Although this intrinsic is not standard Fortran,
-it is a popular extension offered by many compilers
-that support @code{DOUBLE COMPLEX}, since it offers
-the easiest way to extract the real part of a @code{DOUBLE COMPLEX}
-value without using the Fortran 90 @code{REAL()} intrinsic
-in a way that produces a return value inconsistent with
-the way many FORTRAN 77 compilers handle @code{REAL()} of
-a @code{DOUBLE COMPLEX} value.
-
-@xref{RealPart Intrinsic}, for information on a GNU Fortran
-intrinsic that avoids these areas of confusion.
-
-@xref{Dble Intrinsic}, for information on the standard FORTRAN 77
-replacement for @code{DREAL()}.
-
-@xref{REAL() and AIMAG() of Complex}, for more information on
-this issue.
-
-@end ifset
-@ifset familyF77
-@node DSign Intrinsic
-@subsubsection DSign Intrinsic
-@cindex DSign intrinsic
-@cindex intrinsics, DSign
-
-@noindent
-@example
-DSign(@var{A}, @var{B})
-@end example
-
-@noindent
-DSign: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-@var{B}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SIGN()} that is specific
-to one type for @var{A} and @var{B}.
-@xref{Sign Intrinsic}.
-
-@node DSin Intrinsic
-@subsubsection DSin Intrinsic
-@cindex DSin intrinsic
-@cindex intrinsics, DSin
-
-@noindent
-@example
-DSin(@var{X})
-@end example
-
-@noindent
-DSin: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SIN()} that is specific
-to one type for @var{X}.
-@xref{Sin Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DSinD Intrinsic
-@subsubsection DSinD Intrinsic
-@cindex DSinD intrinsic
-@cindex intrinsics, DSinD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DSinD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DSinH Intrinsic
-@subsubsection DSinH Intrinsic
-@cindex DSinH intrinsic
-@cindex intrinsics, DSinH
-
-@noindent
-@example
-DSinH(@var{X})
-@end example
-
-@noindent
-DSinH: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SINH()} that is specific
-to one type for @var{X}.
-@xref{SinH Intrinsic}.
-
-@node DSqRt Intrinsic
-@subsubsection DSqRt Intrinsic
-@cindex DSqRt intrinsic
-@cindex intrinsics, DSqRt
-
-@noindent
-@example
-DSqRt(@var{X})
-@end example
-
-@noindent
-DSqRt: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SQRT()} that is specific
-to one type for @var{X}.
-@xref{SqRt Intrinsic}.
-
-@node DTan Intrinsic
-@subsubsection DTan Intrinsic
-@cindex DTan intrinsic
-@cindex intrinsics, DTan
-
-@noindent
-@example
-DTan(@var{X})
-@end example
-
-@noindent
-DTan: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{TAN()} that is specific
-to one type for @var{X}.
-@xref{Tan Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node DTanD Intrinsic
-@subsubsection DTanD Intrinsic
-@cindex DTanD intrinsic
-@cindex intrinsics, DTanD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL DTanD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node DTanH Intrinsic
-@subsubsection DTanH Intrinsic
-@cindex DTanH intrinsic
-@cindex intrinsics, DTanH
-
-@noindent
-@example
-DTanH(@var{X})
-@end example
-
-@noindent
-DTanH: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{X}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{TANH()} that is specific
-to one type for @var{X}.
-@xref{TanH Intrinsic}.
-
-@end ifset
-@ifset familyF2U
-@node DTime Intrinsic (subroutine)
-@subsubsection DTime Intrinsic (subroutine)
-@cindex DTime intrinsic
-@cindex intrinsics, DTime
-
-@noindent
-@example
-CALL DTime(@var{TArray}, @var{Result})
-@end example
-
-@noindent
-@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
-
-@noindent
-@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Initially, return the number of seconds of runtime
-since the start of the process's execution
-in @var{Result},
-and the user and system components of this in @samp{@var{TArray}(1)}
-and @samp{@var{TArray}(2)} respectively.
-The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
-
-Subsequent invocations of @samp{DTIME()} set values based on accumulations
-since the previous invocation.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{DTime Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node DTime Intrinsic (function)
-@subsubsection DTime Intrinsic (function)
-@cindex DTime intrinsic
-@cindex intrinsics, DTime
-
-@noindent
-@example
-DTime(@var{TArray})
-@end example
-
-@noindent
-DTime: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Initially, return the number of seconds of runtime
-since the start of the process's execution
-as the function value,
-and the user and system components of this in @samp{@var{TArray}(1)}
-and @samp{@var{TArray}(2)} respectively.
-The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
-
-Subsequent invocations of @samp{DTIME()} return values accumulated since the
-previous invocation.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{DTime Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node EOShift Intrinsic
-@subsubsection EOShift Intrinsic
-@cindex EOShift intrinsic
-@cindex intrinsics, EOShift
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL EOShift} to use this name for an
-external procedure.
-
-@node Epsilon Intrinsic
-@subsubsection Epsilon Intrinsic
-@cindex Epsilon intrinsic
-@cindex intrinsics, Epsilon
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Epsilon} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node ErF Intrinsic
-@subsubsection ErF Intrinsic
-@cindex ErF intrinsic
-@cindex intrinsics, ErF
-
-@noindent
-@example
-ErF(@var{X})
-@end example
-
-@noindent
-ErF: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the error function of @var{X}.
-See @code{erf(3m)}, which provides the implementation.
-
-@node ErFC Intrinsic
-@subsubsection ErFC Intrinsic
-@cindex ErFC intrinsic
-@cindex intrinsics, ErFC
-
-@noindent
-@example
-ErFC(@var{X})
-@end example
-
-@noindent
-ErFC: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the complementary error function of @var{X}:
-@samp{ERFC(R) = 1 - ERF(R)} (except that the result might be more
-accurate than explicitly evaluating that formulae would give).
-See @code{erfc(3m)}, which provides the implementation.
-
-@node ETime Intrinsic (subroutine)
-@subsubsection ETime Intrinsic (subroutine)
-@cindex ETime intrinsic
-@cindex intrinsics, ETime
-
-@noindent
-@example
-CALL ETime(@var{TArray}, @var{Result})
-@end example
-
-@noindent
-@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
-
-@noindent
-@var{Result}: @code{REAL(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Return the number of seconds of runtime
-since the start of the process's execution
-in @var{Result},
-and the user and system components of this in @samp{@var{TArray}(1)}
-and @samp{@var{TArray}(2)} respectively.
-The value of @var{Result} is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{ETime Intrinsic (function)}.
-
-@node ETime Intrinsic (function)
-@subsubsection ETime Intrinsic (function)
-@cindex ETime intrinsic
-@cindex intrinsics, ETime
-
-@noindent
-@example
-ETime(@var{TArray})
-@end example
-
-@noindent
-ETime: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{TArray}: @code{REAL(KIND=1)}; DIMENSION(2); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Return the number of seconds of runtime
-since the start of the process's execution
-as the function value,
-and the user and system components of this in @samp{@var{TArray}(1)}
-and @samp{@var{TArray}(2)} respectively.
-The functions' value is equal to @samp{@var{TArray}(1) + @var{TArray}(2)}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-For information on other intrinsics with the same name:
-@xref{ETime Intrinsic (subroutine)}.
-
-@node Exit Intrinsic
-@subsubsection Exit Intrinsic
-@cindex Exit intrinsic
-@cindex intrinsics, Exit
-
-@noindent
-@example
-CALL Exit(@var{Status})
-@end example
-
-@noindent
-@var{Status}: @code{INTEGER} not wider than the default kind; OPTIONAL; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Exit the program with status @var{Status} after closing open Fortran
-I/O units and otherwise behaving as @code{exit(2)}.
-If @var{Status} is omitted the canonical `success' value
-will be returned to the system.
-
-@end ifset
-@ifset familyF77
-@node Exp Intrinsic
-@subsubsection Exp Intrinsic
-@cindex Exp intrinsic
-@cindex intrinsics, Exp
-
-@noindent
-@example
-Exp(@var{X})
-@end example
-
-@noindent
-Exp: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{@var{e}**@var{X}}, where
-@var{e} is approximately 2.7182818.
-
-@xref{Log Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyF90
-@node Exponent Intrinsic
-@subsubsection Exponent Intrinsic
-@cindex Exponent intrinsic
-@cindex intrinsics, Exponent
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Exponent} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node FDate Intrinsic (subroutine)
-@subsubsection FDate Intrinsic (subroutine)
-@cindex FDate intrinsic
-@cindex intrinsics, FDate
-
-@noindent
-@example
-CALL FDate(@var{Date})
-@end example
-
-@noindent
-@var{Date}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the current date (using the same format as @code{CTIME()})
-in @var{Date}.
-
-Equivalent to:
-
-@example
-CALL CTIME(@var{Date}, TIME8())
-@end example
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-@xref{CTime Intrinsic (subroutine)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{FDate Intrinsic (function)}.
-
-@node FDate Intrinsic (function)
-@subsubsection FDate Intrinsic (function)
-@cindex FDate intrinsic
-@cindex intrinsics, FDate
-
-@noindent
-@example
-FDate()
-@end example
-
-@noindent
-FDate: @code{CHARACTER*(*)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the current date (using the same format as @code{CTIME()}).
-
-Equivalent to:
-
-@example
-CTIME(TIME8())
-@end example
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-@xref{CTime Intrinsic (function)}.
-
-For information on other intrinsics with the same name:
-@xref{FDate Intrinsic (subroutine)}.
-
-@node FGet Intrinsic (subroutine)
-@subsubsection FGet Intrinsic (subroutine)
-@cindex FGet intrinsic
-@cindex intrinsics, FGet
-
-@noindent
-@example
-CALL FGet(@var{C}, @var{Status})
-@end example
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Reads a single character into @var{C} in stream mode from unit 5
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns in
-@var{Status} 0 on success, @minus{}1 on end-of-file, and the error code
-from @code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FGet Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node FGet Intrinsic (function)
-@subsubsection FGet Intrinsic (function)
-@cindex FGet intrinsic
-@cindex intrinsics, FGet
-
-@noindent
-@example
-FGet(@var{C})
-@end example
-
-@noindent
-FGet: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Reads a single character into @var{C} in stream mode from unit 5
-(by-passing normal formatted input) using @code{getc(3)}.
-Returns 0 on
-success, @minus{}1 on end-of-file, and the error code from
-@code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FGet Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF2U
-@node FGetC Intrinsic (subroutine)
-@subsubsection FGetC Intrinsic (subroutine)
-@cindex FGetC intrinsic
-@cindex intrinsics, FGetC
-
-@noindent
-@example
-CALL FGetC(@var{Unit}, @var{C}, @var{Status})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Reads a single character into @var{C} in stream mode from unit @var{Unit}
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns in
-@var{Status} 0 on success, @minus{}1 on end-of-file, and the error code from
-@code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FGetC Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node FGetC Intrinsic (function)
-@subsubsection FGetC Intrinsic (function)
-@cindex FGetC intrinsic
-@cindex intrinsics, FGetC
-
-@noindent
-@example
-FGetC(@var{Unit}, @var{C})
-@end example
-
-@noindent
-FGetC: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Reads a single character into @var{C} in stream mode from unit @var{Unit}
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns 0 on
-success, @minus{}1 on end-of-file, and the error code from
-@code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FGetC Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF77
-@node Float Intrinsic
-@subsubsection Float Intrinsic
-@cindex Float intrinsic
-@cindex intrinsics, Float
-
-@noindent
-@example
-Float(@var{A})
-@end example
-
-@noindent
-Float: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{REAL()} that is specific
-to one type for @var{A}.
-@xref{Real Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node FloatI Intrinsic
-@subsubsection FloatI Intrinsic
-@cindex FloatI intrinsic
-@cindex intrinsics, FloatI
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL FloatI} to use this name for an
-external procedure.
-
-@node FloatJ Intrinsic
-@subsubsection FloatJ Intrinsic
-@cindex FloatJ intrinsic
-@cindex intrinsics, FloatJ
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL FloatJ} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node Floor Intrinsic
-@subsubsection Floor Intrinsic
-@cindex Floor intrinsic
-@cindex intrinsics, Floor
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Floor} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node Flush Intrinsic
-@subsubsection Flush Intrinsic
-@cindex Flush intrinsic
-@cindex intrinsics, Flush
-
-@noindent
-@example
-CALL Flush(@var{Unit})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Flushes Fortran unit(s) currently open for output.
-Without the optional argument, all such units are flushed,
-otherwise just the unit specified by @var{Unit}.
-
-Some non-GNU implementations of Fortran provide this intrinsic
-as a library procedure that might or might not support the
-(optional) @var{Unit} argument.
-
-@node FNum Intrinsic
-@subsubsection FNum Intrinsic
-@cindex FNum intrinsic
-@cindex intrinsics, FNum
-
-@noindent
-@example
-FNum(@var{Unit})
-@end example
-
-@noindent
-FNum: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the Unix file descriptor number corresponding to the open
-Fortran I/O unit @var{Unit}.
-This could be passed to an interface to C I/O routines.
-
-@node FPut Intrinsic (subroutine)
-@subsubsection FPut Intrinsic (subroutine)
-@cindex FPut intrinsic
-@cindex intrinsics, FPut
-
-@noindent
-@example
-CALL FPut(@var{C}, @var{Status})
-@end example
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Writes the single character @var{C} in stream mode to unit 6
-(by-passing normal formatted output) using @code{putc(3)}.
-Returns in
-@var{Status} 0 on success, the error code from @code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FPut Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node FPut Intrinsic (function)
-@subsubsection FPut Intrinsic (function)
-@cindex FPut intrinsic
-@cindex intrinsics, FPut
-
-@noindent
-@example
-FPut(@var{C})
-@end example
-
-@noindent
-FPut: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Writes the single character @var{C} in stream mode to unit 6
-(by-passing normal formatted output) using @code{getc(3)}.
-Returns 0 on
-success, the error code from @code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FPut Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF2U
-@node FPutC Intrinsic (subroutine)
-@subsubsection FPutC Intrinsic (subroutine)
-@cindex FPutC intrinsic
-@cindex intrinsics, FPutC
-
-@noindent
-@example
-CALL FPutC(@var{Unit}, @var{C}, @var{Status})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Writes the single character @var{Unit} in stream mode to unit 6
-(by-passing normal formatted output) using @code{putc(3)}.
-Returns in
-@var{C} 0 on success, the error code from @code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FPutC Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node FPutC Intrinsic (function)
-@subsubsection FPutC Intrinsic (function)
-@cindex FPutC intrinsic
-@cindex intrinsics, FPutC
-
-@noindent
-@example
-FPutC(@var{Unit}, @var{C})
-@end example
-
-@noindent
-FPutC: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Writes the single character @var{C} in stream mode to unit @var{Unit}
-(by-passing normal formatted output) using @code{putc(3)}.
-Returns 0 on
-success, the error code from @code{ferror(3)} otherwise.
-
-Stream I/O should not be mixed with normal record-oriented (formatted or
-unformatted) I/O on the same unit; the results are unpredictable.
-
-For information on other intrinsics with the same name:
-@xref{FPutC Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node Fraction Intrinsic
-@subsubsection Fraction Intrinsic
-@cindex Fraction intrinsic
-@cindex intrinsics, Fraction
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Fraction} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node FSeek Intrinsic
-@subsubsection FSeek Intrinsic
-@cindex FSeek intrinsic
-@cindex intrinsics, FSeek
-
-@noindent
-@example
-CALL FSeek(@var{Unit}, @var{Offset}, @var{Whence}, @var{ErrLab})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Offset}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Whence}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{ErrLab}: @samp{*@var{label}}, where @var{label} is the label
-of an executable statement; OPTIONAL.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Attempts to move Fortran unit @var{Unit} to the specified
-@var{Offset}: absolute offset if @var{Whence}=0; relative to the
-current offset if @var{Whence}=1; relative to the end of the file if
-@var{Whence}=2.
-It branches to label @var{ErrLab} if @var{Unit} is
-not open or if the call otherwise fails.
-
-@node FStat Intrinsic (subroutine)
-@subsubsection FStat Intrinsic (subroutine)
-@cindex FStat intrinsic
-@cindex intrinsics, FStat
-
-@noindent
-@example
-CALL FStat(@var{Unit}, @var{SArray}, @var{Status})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Obtains data about the file open on Fortran I/O unit @var{Unit} and
-places them in the array @var{SArray}.
-The values in this array are
-extracted from the @code{stat} structure as returned by
-@code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{FStat Intrinsic (function)}.
-
-@node FStat Intrinsic (function)
-@subsubsection FStat Intrinsic (function)
-@cindex FStat intrinsic
-@cindex intrinsics, FStat
-
-@noindent
-@example
-FStat(@var{Unit}, @var{SArray})
-@end example
-
-@noindent
-FStat: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Obtains data about the file open on Fortran I/O unit @var{Unit} and
-places them in the array @var{SArray}.
-The values in this array are
-extracted from the @code{stat} structure as returned by
-@code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-Returns 0 on success or a nonzero error code.
-
-For information on other intrinsics with the same name:
-@xref{FStat Intrinsic (subroutine)}.
-
-@node FTell Intrinsic (subroutine)
-@subsubsection FTell Intrinsic (subroutine)
-@cindex FTell intrinsic
-@cindex intrinsics, FTell
-
-@noindent
-@example
-CALL FTell(@var{Unit}, @var{Offset})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Offset}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sets @var{Offset} to the current offset of Fortran unit @var{Unit}
-(or to @minus{}1 if @var{Unit} is not open).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{FTell Intrinsic (function)}.
-
-@node FTell Intrinsic (function)
-@subsubsection FTell Intrinsic (function)
-@cindex FTell intrinsic
-@cindex intrinsics, FTell
-
-@noindent
-@example
-FTell(@var{Unit})
-@end example
-
-@noindent
-FTell: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the current offset of Fortran unit @var{Unit}
-(or @minus{}1 if @var{Unit} is not open).
-
-For information on other intrinsics with the same name:
-@xref{FTell Intrinsic (subroutine)}.
-
-@node GError Intrinsic
-@subsubsection GError Intrinsic
-@cindex GError intrinsic
-@cindex intrinsics, GError
-
-@noindent
-@example
-CALL GError(@var{Message})
-@end example
-
-@noindent
-@var{Message}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the system error message corresponding to the last system
-error (C @code{errno}).
-
-@node GetArg Intrinsic
-@subsubsection GetArg Intrinsic
-@cindex GetArg intrinsic
-@cindex intrinsics, GetArg
-
-@noindent
-@example
-CALL GetArg(@var{Pos}, @var{Value})
-@end example
-
-@noindent
-@var{Pos}: @code{INTEGER} not wider than the default kind; scalar; INTENT(IN).
-
-@noindent
-@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sets @var{Value} to the @var{Pos}-th command-line argument (or to all
-blanks if there are fewer than @var{Value} command-line arguments);
-@code{CALL GETARG(0, @var{value})} sets @var{value} to the name of the
-program (on systems that support this feature).
-
-@xref{IArgC Intrinsic}, for information on how to get the number
-of arguments.
-
-@node GetCWD Intrinsic (subroutine)
-@subsubsection GetCWD Intrinsic (subroutine)
-@cindex GetCWD intrinsic
-@cindex intrinsics, GetCWD
-
-@noindent
-@example
-CALL GetCWD(@var{Name}, @var{Status})
-@end example
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Places the current working directory in @var{Name}.
-If the @var{Status} argument is supplied, it contains 0
-success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
-or @code{getwd(3)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{GetCWD Intrinsic (function)}.
-
-@node GetCWD Intrinsic (function)
-@subsubsection GetCWD Intrinsic (function)
-@cindex GetCWD intrinsic
-@cindex intrinsics, GetCWD
-
-@noindent
-@example
-GetCWD(@var{Name})
-@end example
-
-@noindent
-GetCWD: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Places the current working directory in @var{Name}.
-Returns 0 on
-success, otherwise a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{getcwd(3)}
-or @code{getwd(3)}).
-
-For information on other intrinsics with the same name:
-@xref{GetCWD Intrinsic (subroutine)}.
-
-@node GetEnv Intrinsic
-@subsubsection GetEnv Intrinsic
-@cindex GetEnv intrinsic
-@cindex intrinsics, GetEnv
-
-@noindent
-@example
-CALL GetEnv(@var{Name}, @var{Value})
-@end example
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Value}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sets @var{Value} to the value of environment variable given by the
-value of @var{Name} (@code{$name} in shell terms) or to blanks if
-@code{$name} has not been set.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{Name}---otherwise,
-trailing blanks in @var{Name} are ignored.
-
-@node GetGId Intrinsic
-@subsubsection GetGId Intrinsic
-@cindex GetGId intrinsic
-@cindex intrinsics, GetGId
-
-@noindent
-@example
-GetGId()
-@end example
-
-@noindent
-GetGId: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the group id for the current process.
-
-@node GetLog Intrinsic
-@subsubsection GetLog Intrinsic
-@cindex GetLog intrinsic
-@cindex intrinsics, GetLog
-
-@noindent
-@example
-CALL GetLog(@var{Login})
-@end example
-
-@noindent
-@var{Login}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the login name for the process in @var{Login}.
-
-@emph{Caution:} On some systems, the @code{getlogin(3)}
-function, which this intrinsic calls at run time,
-is either not implemented or returns a null pointer.
-In the latter case, this intrinsic returns blanks
-in @var{Login}.
-
-@node GetPId Intrinsic
-@subsubsection GetPId Intrinsic
-@cindex GetPId intrinsic
-@cindex intrinsics, GetPId
-
-@noindent
-@example
-GetPId()
-@end example
-
-@noindent
-GetPId: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the process id for the current process.
-
-@node GetUId Intrinsic
-@subsubsection GetUId Intrinsic
-@cindex GetUId intrinsic
-@cindex intrinsics, GetUId
-
-@noindent
-@example
-GetUId()
-@end example
-
-@noindent
-GetUId: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the user id for the current process.
-
-@node GMTime Intrinsic
-@subsubsection GMTime Intrinsic
-@cindex GMTime intrinsic
-@cindex intrinsics, GMTime
-
-@noindent
-@example
-CALL GMTime(@var{STime}, @var{TArray})
-@end example
-
-@noindent
-@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Given a system time value @var{STime}, fills @var{TArray} with values
-extracted from it appropriate to the GMT time zone using
-@code{gmtime(3)}.
-
-The array elements are as follows:
-
-@enumerate
-@item
-Seconds after the minute, range 0--59 or 0--61 to allow for leap
-seconds
-
-@item
-Minutes after the hour, range 0--59
-
-@item
-Hours past midnight, range 0--23
-
-@item
-Day of month, range 0--31
-
-@item
-Number of months since January, range 0--12
-
-@item
-Years since 1900
-
-@item
-Number of days since Sunday, range 0--6
-
-@item
-Days since January 1
-
-@item
-Daylight savings indicator: positive if daylight savings is in effect,
-zero if not, and negative if the information isn't available.
-@end enumerate
-
-@node HostNm Intrinsic (subroutine)
-@subsubsection HostNm Intrinsic (subroutine)
-@cindex HostNm intrinsic
-@cindex intrinsics, HostNm
-
-@noindent
-@example
-CALL HostNm(@var{Name}, @var{Status})
-@end example
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Fills @var{Name} with the system's host name returned by
-@code{gethostname(2)}.
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-On some systems (specifically SCO) it might be necessary to link the
-``socket'' library if you call this routine.
-Typically this means adding @samp{-lg2c -lsocket -lm}
-to the @code{g77} command line when linking the program.
-
-For information on other intrinsics with the same name:
-@xref{HostNm Intrinsic (function)}.
-
-@node HostNm Intrinsic (function)
-@subsubsection HostNm Intrinsic (function)
-@cindex HostNm intrinsic
-@cindex intrinsics, HostNm
-
-@noindent
-@example
-HostNm(@var{Name})
-@end example
-
-@noindent
-HostNm: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Fills @var{Name} with the system's host name returned by
-@code{gethostname(2)}, returning 0 on success or a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{gethostname(2)}).
-
-On some systems (specifically SCO) it might be necessary to link the
-``socket'' library if you call this routine.
-Typically this means adding @samp{-lg2c -lsocket -lm}
-to the @code{g77} command line when linking the program.
-
-For information on other intrinsics with the same name:
-@xref{HostNm Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node Huge Intrinsic
-@subsubsection Huge Intrinsic
-@cindex Huge intrinsic
-@cindex intrinsics, Huge
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Huge} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node IAbs Intrinsic
-@subsubsection IAbs Intrinsic
-@cindex IAbs intrinsic
-@cindex intrinsics, IAbs
-
-@noindent
-@example
-IAbs(@var{A})
-@end example
-
-@noindent
-IAbs: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{ABS()} that is specific
-to one type for @var{A}.
-@xref{Abs Intrinsic}.
-
-@end ifset
-@ifset familyASC
-@node IAChar Intrinsic
-@subsubsection IAChar Intrinsic
-@cindex IAChar intrinsic
-@cindex intrinsics, IAChar
-
-@noindent
-@example
-IAChar(@var{C})
-@end example
-
-@noindent
-IAChar: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}, @code{f90}.
-
-@noindent
-Description:
-
-Returns the code for the ASCII character in the
-first character position of @var{C}.
-
-@xref{AChar Intrinsic}, for the inverse of this function.
-
-@xref{IChar Intrinsic}, for the function corresponding
-to the system's native character set.
-
-@end ifset
-@ifset familyMIL
-@node IAnd Intrinsic
-@subsubsection IAnd Intrinsic
-@cindex IAnd intrinsic
-@cindex intrinsics, IAnd
-
-@noindent
-@example
-IAnd(@var{I}, @var{J})
-@end example
-
-@noindent
-IAnd: @code{INTEGER} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{J}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean AND of
-pair of bits in each of @var{I} and @var{J}.
-
-@end ifset
-@ifset familyF2U
-@node IArgC Intrinsic
-@subsubsection IArgC Intrinsic
-@cindex IArgC intrinsic
-@cindex intrinsics, IArgC
-
-@noindent
-@example
-IArgC()
-@end example
-
-@noindent
-IArgC: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the number of command-line arguments.
-
-This count does not include the specification of the program
-name itself.
-
-@end ifset
-@ifset familyMIL
-@node IBClr Intrinsic
-@subsubsection IBClr Intrinsic
-@cindex IBClr intrinsic
-@cindex intrinsics, IBClr
-
-@noindent
-@example
-IBClr(@var{I}, @var{Pos})
-@end example
-
-@noindent
-IBClr: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns the value of @var{I} with bit @var{Pos} cleared (set to
-zero).
-@xref{BTest Intrinsic}, for information on bit positions.
-
-@node IBits Intrinsic
-@subsubsection IBits Intrinsic
-@cindex IBits intrinsic
-@cindex intrinsics, IBits
-
-@noindent
-@example
-IBits(@var{I}, @var{Pos}, @var{Len})
-@end example
-
-@noindent
-IBits: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Len}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Extracts a subfield of length @var{Len} from @var{I}, starting from
-bit position @var{Pos} and extending left for @var{Len} bits.
-The result is right-justified and the remaining bits are zeroed.
-The value
-of @samp{@var{Pos}+@var{Len}} must be less than or equal to the value
-@samp{BIT_SIZE(@var{I})}.
-@xref{Bit_Size Intrinsic}.
-
-@node IBSet Intrinsic
-@subsubsection IBSet Intrinsic
-@cindex IBSet intrinsic
-@cindex intrinsics, IBSet
-
-@noindent
-@example
-IBSet(@var{I}, @var{Pos})
-@end example
-
-@noindent
-IBSet: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Pos}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns the value of @var{I} with bit @var{Pos} set (to one).
-@xref{BTest Intrinsic}, for information on bit positions.
-
-@end ifset
-@ifset familyF77
-@node IChar Intrinsic
-@subsubsection IChar Intrinsic
-@cindex IChar intrinsic
-@cindex intrinsics, IChar
-
-@noindent
-@example
-IChar(@var{C})
-@end example
-
-@noindent
-IChar: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{C}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the code for the character in the
-first character position of @var{C}.
-
-Because the system's native character set is used,
-the correspondence between character and their codes
-is not necessarily the same between GNU Fortran
-implementations.
-
-Note that no intrinsic exists to convert a printable
-character string to a numerical value.
-For example, there is no intrinsic that, given
-the @code{CHARACTER} value @samp{'154'}, returns an
-@code{INTEGER} or @code{REAL} value with the value @samp{154}.
-
-Instead, you can use internal-file I/O to do this kind
-of conversion.
-For example:
-
-@smallexample
-INTEGER VALUE
-CHARACTER*10 STRING
-STRING = '154'
-READ (STRING, '(I10)'), VALUE
-PRINT *, VALUE
-END
-@end smallexample
-
-The above program, when run, prints:
-
-@smallexample
- 154
-@end smallexample
-
-@xref{Char Intrinsic}, for the inverse of the @code{ICHAR} function.
-
-@xref{IAChar Intrinsic}, for the function corresponding
-to the ASCII character set.
-
-@end ifset
-@ifset familyF2U
-@node IDate Intrinsic (UNIX)
-@subsubsection IDate Intrinsic (UNIX)
-@cindex IDate intrinsic
-@cindex intrinsics, IDate
-
-@noindent
-@example
-CALL IDate(@var{TArray})
-@end example
-
-@noindent
-@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Fills @var{TArray} with the numerical values at the current local time.
-The day (in the range 1--31), month (in the range 1--12),
-and year appear in elements 1, 2, and 3 of @var{TArray}, respectively.
-The year has four significant digits.
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-For information on other intrinsics with the same name:
-@xref{IDate Intrinsic (VXT)}.
-
-@end ifset
-@ifset familyVXT
-@node IDate Intrinsic (VXT)
-@subsubsection IDate Intrinsic (VXT)
-@cindex IDate intrinsic
-@cindex intrinsics, IDate
-
-@noindent
-@example
-CALL IDate(@var{M}, @var{D}, @var{Y})
-@end example
-
-@noindent
-@var{M}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-@var{D}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{vxt}.
-
-@noindent
-Description:
-
-Returns the numerical values of the current local time.
-The month (in the range 1--12) is returned in @var{M},
-the day (in the range 1--31) in @var{D},
-and the year in @var{Y} (in the range 0--99).
-
-@cindex Y2K compliance
-@cindex Year 2000 compliance
-@cindex wraparound, Y2K
-@cindex limits, Y2K
-This intrinsic is not recommended, due to the fact that
-its return value for year wraps around century boundaries
-(change from a larger value to a smaller one).
-Therefore, programs making use of this intrinsic, for
-instance, might not be Year 2000 (Y2K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-as of the Year 2000.
-
-@xref{IDate Intrinsic (UNIX)}, for information on obtaining more digits
-for the current date.
-
-For information on other intrinsics with the same name:
-@xref{IDate Intrinsic (UNIX)}.
-
-@end ifset
-@ifset familyF77
-@node IDiM Intrinsic
-@subsubsection IDiM Intrinsic
-@cindex IDiM intrinsic
-@cindex intrinsics, IDiM
-
-@noindent
-@example
-IDiM(@var{X}, @var{Y})
-@end example
-
-@noindent
-IDiM: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{X}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-@var{Y}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{DIM()} that is specific
-to one type for @var{X} and @var{Y}.
-@xref{DiM Intrinsic}.
-
-@node IDInt Intrinsic
-@subsubsection IDInt Intrinsic
-@cindex IDInt intrinsic
-@cindex intrinsics, IDInt
-
-@noindent
-@example
-IDInt(@var{A})
-@end example
-
-@noindent
-IDInt: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{INT()} that is specific
-to one type for @var{A}.
-@xref{Int Intrinsic}.
-
-@node IDNInt Intrinsic
-@subsubsection IDNInt Intrinsic
-@cindex IDNInt intrinsic
-@cindex intrinsics, IDNInt
-
-@noindent
-@example
-IDNInt(@var{A})
-@end example
-
-@noindent
-IDNInt: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{NINT()} that is specific
-to one type for @var{A}.
-@xref{NInt Intrinsic}.
-
-@end ifset
-@ifset familyMIL
-@node IEOr Intrinsic
-@subsubsection IEOr Intrinsic
-@cindex IEOr intrinsic
-@cindex intrinsics, IEOr
-
-@noindent
-@example
-IEOr(@var{I}, @var{J})
-@end example
-
-@noindent
-IEOr: @code{INTEGER} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{J}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean exclusive-OR of
-pair of bits in each of @var{I} and @var{J}.
-
-@end ifset
-@ifset familyF2U
-@node IErrNo Intrinsic
-@subsubsection IErrNo Intrinsic
-@cindex IErrNo intrinsic
-@cindex intrinsics, IErrNo
-
-@noindent
-@example
-IErrNo()
-@end example
-
-@noindent
-IErrNo: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the last system error number (corresponding to the C
-@code{errno}).
-
-@end ifset
-@ifset familyF77
-@node IFix Intrinsic
-@subsubsection IFix Intrinsic
-@cindex IFix intrinsic
-@cindex intrinsics, IFix
-
-@noindent
-@example
-IFix(@var{A})
-@end example
-
-@noindent
-IFix: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{INT()} that is specific
-to one type for @var{A}.
-@xref{Int Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node IIAbs Intrinsic
-@subsubsection IIAbs Intrinsic
-@cindex IIAbs intrinsic
-@cindex intrinsics, IIAbs
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIAbs} to use this name for an
-external procedure.
-
-@node IIAnd Intrinsic
-@subsubsection IIAnd Intrinsic
-@cindex IIAnd intrinsic
-@cindex intrinsics, IIAnd
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIAnd} to use this name for an
-external procedure.
-
-@node IIBClr Intrinsic
-@subsubsection IIBClr Intrinsic
-@cindex IIBClr intrinsic
-@cindex intrinsics, IIBClr
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIBClr} to use this name for an
-external procedure.
-
-@node IIBits Intrinsic
-@subsubsection IIBits Intrinsic
-@cindex IIBits intrinsic
-@cindex intrinsics, IIBits
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIBits} to use this name for an
-external procedure.
-
-@node IIBSet Intrinsic
-@subsubsection IIBSet Intrinsic
-@cindex IIBSet intrinsic
-@cindex intrinsics, IIBSet
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIBSet} to use this name for an
-external procedure.
-
-@node IIDiM Intrinsic
-@subsubsection IIDiM Intrinsic
-@cindex IIDiM intrinsic
-@cindex intrinsics, IIDiM
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIDiM} to use this name for an
-external procedure.
-
-@node IIDInt Intrinsic
-@subsubsection IIDInt Intrinsic
-@cindex IIDInt intrinsic
-@cindex intrinsics, IIDInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIDInt} to use this name for an
-external procedure.
-
-@node IIDNnt Intrinsic
-@subsubsection IIDNnt Intrinsic
-@cindex IIDNnt intrinsic
-@cindex intrinsics, IIDNnt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIDNnt} to use this name for an
-external procedure.
-
-@node IIEOr Intrinsic
-@subsubsection IIEOr Intrinsic
-@cindex IIEOr intrinsic
-@cindex intrinsics, IIEOr
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIEOr} to use this name for an
-external procedure.
-
-@node IIFix Intrinsic
-@subsubsection IIFix Intrinsic
-@cindex IIFix intrinsic
-@cindex intrinsics, IIFix
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIFix} to use this name for an
-external procedure.
-
-@node IInt Intrinsic
-@subsubsection IInt Intrinsic
-@cindex IInt intrinsic
-@cindex intrinsics, IInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IInt} to use this name for an
-external procedure.
-
-@node IIOr Intrinsic
-@subsubsection IIOr Intrinsic
-@cindex IIOr intrinsic
-@cindex intrinsics, IIOr
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIOr} to use this name for an
-external procedure.
-
-@node IIQint Intrinsic
-@subsubsection IIQint Intrinsic
-@cindex IIQint intrinsic
-@cindex intrinsics, IIQint
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIQint} to use this name for an
-external procedure.
-
-@node IIQNnt Intrinsic
-@subsubsection IIQNnt Intrinsic
-@cindex IIQNnt intrinsic
-@cindex intrinsics, IIQNnt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIQNnt} to use this name for an
-external procedure.
-
-@node IIShftC Intrinsic
-@subsubsection IIShftC Intrinsic
-@cindex IIShftC intrinsic
-@cindex intrinsics, IIShftC
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IIShftC} to use this name for an
-external procedure.
-
-@node IISign Intrinsic
-@subsubsection IISign Intrinsic
-@cindex IISign intrinsic
-@cindex intrinsics, IISign
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IISign} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2C
-@node Imag Intrinsic
-@subsubsection Imag Intrinsic
-@cindex Imag intrinsic
-@cindex intrinsics, Imag
-
-@noindent
-@example
-Imag(@var{Z})
-@end example
-
-@noindent
-Imag: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
-
-@noindent
-@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-The imaginary part of @var{Z} is returned, without conversion.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is @samp{AIMAG(@var{Z})}.
-However, when, for example, @var{Z} is @code{DOUBLE COMPLEX},
-@samp{AIMAG(@var{Z})} means something different for some compilers
-that are not true Fortran 90 compilers but offer some
-extensions standardized by Fortran 90 (such as the
-@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
-
-The advantage of @code{IMAG()} is that, while not necessarily
-more or less portable than @code{AIMAG()}, it is more likely to
-cause a compiler that doesn't support it to produce a diagnostic
-than generate incorrect code.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-
-@end ifset
-@ifset familyGNU
-@node ImagPart Intrinsic
-@subsubsection ImagPart Intrinsic
-@cindex ImagPart intrinsic
-@cindex intrinsics, ImagPart
-
-@noindent
-@example
-ImagPart(@var{Z})
-@end example
-
-@noindent
-ImagPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
-
-@noindent
-@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{gnu}.
-
-@noindent
-Description:
-
-The imaginary part of @var{Z} is returned, without conversion.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is @samp{AIMAG(@var{Z})}.
-However, when, for example, @var{Z} is @code{DOUBLE COMPLEX},
-@samp{AIMAG(@var{Z})} means something different for some compilers
-that are not true Fortran 90 compilers but offer some
-extensions standardized by Fortran 90 (such as the
-@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
-
-The advantage of @code{IMAGPART()} is that, while not necessarily
-more or less portable than @code{AIMAG()}, it is more likely to
-cause a compiler that doesn't support it to produce a diagnostic
-than generate incorrect code.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-
-@end ifset
-@ifset familyVXT
-@node IMax0 Intrinsic
-@subsubsection IMax0 Intrinsic
-@cindex IMax0 intrinsic
-@cindex intrinsics, IMax0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IMax0} to use this name for an
-external procedure.
-
-@node IMax1 Intrinsic
-@subsubsection IMax1 Intrinsic
-@cindex IMax1 intrinsic
-@cindex intrinsics, IMax1
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IMax1} to use this name for an
-external procedure.
-
-@node IMin0 Intrinsic
-@subsubsection IMin0 Intrinsic
-@cindex IMin0 intrinsic
-@cindex intrinsics, IMin0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IMin0} to use this name for an
-external procedure.
-
-@node IMin1 Intrinsic
-@subsubsection IMin1 Intrinsic
-@cindex IMin1 intrinsic
-@cindex intrinsics, IMin1
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IMin1} to use this name for an
-external procedure.
-
-@node IMod Intrinsic
-@subsubsection IMod Intrinsic
-@cindex IMod intrinsic
-@cindex intrinsics, IMod
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IMod} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Index Intrinsic
-@subsubsection Index Intrinsic
-@cindex Index intrinsic
-@cindex intrinsics, Index
-
-@noindent
-@example
-Index(@var{String}, @var{Substring})
-@end example
-
-@noindent
-Index: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Substring}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the position of the start of the first occurrence of string
-@var{Substring} as a substring in @var{String}, counting from one.
-If @var{Substring} doesn't occur in @var{String}, zero is returned.
-
-@end ifset
-@ifset familyVXT
-@node INInt Intrinsic
-@subsubsection INInt Intrinsic
-@cindex INInt intrinsic
-@cindex intrinsics, INInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL INInt} to use this name for an
-external procedure.
-
-@node INot Intrinsic
-@subsubsection INot Intrinsic
-@cindex INot intrinsic
-@cindex intrinsics, INot
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL INot} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Int Intrinsic
-@subsubsection Int Intrinsic
-@cindex Int intrinsic
-@cindex intrinsics, Int
-
-@noindent
-@example
-Int(@var{A})
-@end example
-
-@noindent
-Int: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=1)}.
-
-If @var{A} is type @code{COMPLEX}, its real part is
-truncated and converted, and its imaginary part is disregarded.
-
-@xref{NInt Intrinsic}, for how to convert, rounded to nearest
-whole number.
-
-@xref{AInt Intrinsic}, for how to truncate to whole number
-without converting.
-
-@end ifset
-@ifset familyGNU
-@node Int2 Intrinsic
-@subsubsection Int2 Intrinsic
-@cindex Int2 intrinsic
-@cindex intrinsics, Int2
-
-@noindent
-@example
-Int2(@var{A})
-@end example
-
-@noindent
-Int2: @code{INTEGER(KIND=6)} function.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{gnu}.
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=6)}.
-
-If @var{A} is type @code{COMPLEX}, its real part
-is truncated and converted, and its imaginary part is disregarded.
-
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-
-@node Int8 Intrinsic
-@subsubsection Int8 Intrinsic
-@cindex Int8 intrinsic
-@cindex intrinsics, Int8
-
-@noindent
-@example
-Int8(@var{A})
-@end example
-
-@noindent
-Int8: @code{INTEGER(KIND=2)} function.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{gnu}.
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=2)}.
-
-If @var{A} is type @code{COMPLEX}, its real part
-is truncated and converted, and its imaginary part is disregarded.
-
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-
-@end ifset
-@ifset familyMIL
-@node IOr Intrinsic
-@subsubsection IOr Intrinsic
-@cindex IOr intrinsic
-@cindex intrinsics, IOr
-
-@noindent
-@example
-IOr(@var{I}, @var{J})
-@end example
-
-@noindent
-IOr: @code{INTEGER} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{J}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean OR of
-pair of bits in each of @var{I} and @var{J}.
-
-@end ifset
-@ifset familyF2U
-@node IRand Intrinsic
-@subsubsection IRand Intrinsic
-@cindex IRand intrinsic
-@cindex intrinsics, IRand
-
-@noindent
-@example
-IRand(@var{Flag})
-@end example
-
-@noindent
-IRand: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns a uniform quasi-random number up to a system-dependent limit.
-If @var{Flag} is 0, the next number in sequence is returned; if
-@var{Flag} is 1, the generator is restarted by calling the UNIX function
-@samp{srand(0)}; if @var{Flag} has any other value,
-it is used as a new seed with @code{srand()}.
-
-@xref{SRand Intrinsic}.
-
-@emph{Note:} As typically implemented (by the routine of the same
-name in the C library), this random number generator is a very poor
-one, though the BSD and GNU libraries provide a much better
-implementation than the `traditional' one.
-On a different system you almost certainly want to use something better.
-
-@node IsaTty Intrinsic
-@subsubsection IsaTty Intrinsic
-@cindex IsaTty intrinsic
-@cindex intrinsics, IsaTty
-
-@noindent
-@example
-IsaTty(@var{Unit})
-@end example
-
-@noindent
-IsaTty: @code{LOGICAL(KIND=1)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns @code{.TRUE.} if and only if the Fortran I/O unit
-specified by @var{Unit} is connected
-to a terminal device.
-See @code{isatty(3)}.
-
-@end ifset
-@ifset familyMIL
-@node IShft Intrinsic
-@subsubsection IShft Intrinsic
-@cindex IShft intrinsic
-@cindex intrinsics, IShft
-
-@noindent
-@example
-IShft(@var{I}, @var{Shift})
-@end example
-
-@noindent
-IShft: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-All bits representing @var{I} are shifted @var{Shift} places.
-@samp{@var{Shift}.GT.0} indicates a left shift, @samp{@var{Shift}.EQ.0}
-indicates no shift and @samp{@var{Shift}.LT.0} indicates a right shift.
-If the absolute value of the shift count is greater than
-@samp{BIT_SIZE(@var{I})}, the result is undefined.
-Bits shifted out from the left end or the right end are lost.
-Zeros are shifted in from the opposite end.
-
-@xref{IShftC Intrinsic}, for the circular-shift equivalent.
-
-@node IShftC Intrinsic
-@subsubsection IShftC Intrinsic
-@cindex IShftC intrinsic
-@cindex intrinsics, IShftC
-
-@noindent
-@example
-IShftC(@var{I}, @var{Shift}, @var{Size})
-@end example
-
-@noindent
-IShftC: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Size}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-The rightmost @var{Size} bits of the argument @var{I}
-are shifted circularly @var{Shift}
-places, i.e.@: the bits shifted out of one end are shifted into 
-the opposite end.
-No bits are lost.
-The unshifted bits of the result are the same as
-the unshifted bits of @var{I}.
-The  absolute value of the argument @var{Shift}
-must be less than or equal to @var{Size}.  
-The value of @var{Size} must be greater than or equal to one and less than 
-or equal to @samp{BIT_SIZE(@var{I})}.
-
-@xref{IShft Intrinsic}, for the logical shift equivalent.
-
-@end ifset
-@ifset familyF77
-@node ISign Intrinsic
-@subsubsection ISign Intrinsic
-@cindex ISign intrinsic
-@cindex intrinsics, ISign
-
-@noindent
-@example
-ISign(@var{A}, @var{B})
-@end example
-
-@noindent
-ISign: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-@var{B}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{SIGN()} that is specific
-to one type for @var{A} and @var{B}.
-@xref{Sign Intrinsic}.
-
-@end ifset
-@ifset familyF2U
-@node ITime Intrinsic
-@subsubsection ITime Intrinsic
-@cindex ITime intrinsic
-@cindex intrinsics, ITime
-
-@noindent
-@example
-CALL ITime(@var{TArray})
-@end example
-
-@noindent
-@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(3); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the current local time hour, minutes, and seconds in elements
-1, 2, and 3 of @var{TArray}, respectively.
-
-@end ifset
-@ifset familyVXT
-@node IZExt Intrinsic
-@subsubsection IZExt Intrinsic
-@cindex IZExt intrinsic
-@cindex intrinsics, IZExt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL IZExt} to use this name for an
-external procedure.
-
-@node JIAbs Intrinsic
-@subsubsection JIAbs Intrinsic
-@cindex JIAbs intrinsic
-@cindex intrinsics, JIAbs
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIAbs} to use this name for an
-external procedure.
-
-@node JIAnd Intrinsic
-@subsubsection JIAnd Intrinsic
-@cindex JIAnd intrinsic
-@cindex intrinsics, JIAnd
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIAnd} to use this name for an
-external procedure.
-
-@node JIBClr Intrinsic
-@subsubsection JIBClr Intrinsic
-@cindex JIBClr intrinsic
-@cindex intrinsics, JIBClr
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIBClr} to use this name for an
-external procedure.
-
-@node JIBits Intrinsic
-@subsubsection JIBits Intrinsic
-@cindex JIBits intrinsic
-@cindex intrinsics, JIBits
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIBits} to use this name for an
-external procedure.
-
-@node JIBSet Intrinsic
-@subsubsection JIBSet Intrinsic
-@cindex JIBSet intrinsic
-@cindex intrinsics, JIBSet
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIBSet} to use this name for an
-external procedure.
-
-@node JIDiM Intrinsic
-@subsubsection JIDiM Intrinsic
-@cindex JIDiM intrinsic
-@cindex intrinsics, JIDiM
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIDiM} to use this name for an
-external procedure.
-
-@node JIDInt Intrinsic
-@subsubsection JIDInt Intrinsic
-@cindex JIDInt intrinsic
-@cindex intrinsics, JIDInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIDInt} to use this name for an
-external procedure.
-
-@node JIDNnt Intrinsic
-@subsubsection JIDNnt Intrinsic
-@cindex JIDNnt intrinsic
-@cindex intrinsics, JIDNnt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIDNnt} to use this name for an
-external procedure.
-
-@node JIEOr Intrinsic
-@subsubsection JIEOr Intrinsic
-@cindex JIEOr intrinsic
-@cindex intrinsics, JIEOr
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIEOr} to use this name for an
-external procedure.
-
-@node JIFix Intrinsic
-@subsubsection JIFix Intrinsic
-@cindex JIFix intrinsic
-@cindex intrinsics, JIFix
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIFix} to use this name for an
-external procedure.
-
-@node JInt Intrinsic
-@subsubsection JInt Intrinsic
-@cindex JInt intrinsic
-@cindex intrinsics, JInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JInt} to use this name for an
-external procedure.
-
-@node JIOr Intrinsic
-@subsubsection JIOr Intrinsic
-@cindex JIOr intrinsic
-@cindex intrinsics, JIOr
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIOr} to use this name for an
-external procedure.
-
-@node JIQint Intrinsic
-@subsubsection JIQint Intrinsic
-@cindex JIQint intrinsic
-@cindex intrinsics, JIQint
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIQint} to use this name for an
-external procedure.
-
-@node JIQNnt Intrinsic
-@subsubsection JIQNnt Intrinsic
-@cindex JIQNnt intrinsic
-@cindex intrinsics, JIQNnt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIQNnt} to use this name for an
-external procedure.
-
-@node JIShft Intrinsic
-@subsubsection JIShft Intrinsic
-@cindex JIShft intrinsic
-@cindex intrinsics, JIShft
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIShft} to use this name for an
-external procedure.
-
-@node JIShftC Intrinsic
-@subsubsection JIShftC Intrinsic
-@cindex JIShftC intrinsic
-@cindex intrinsics, JIShftC
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JIShftC} to use this name for an
-external procedure.
-
-@node JISign Intrinsic
-@subsubsection JISign Intrinsic
-@cindex JISign intrinsic
-@cindex intrinsics, JISign
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JISign} to use this name for an
-external procedure.
-
-@node JMax0 Intrinsic
-@subsubsection JMax0 Intrinsic
-@cindex JMax0 intrinsic
-@cindex intrinsics, JMax0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JMax0} to use this name for an
-external procedure.
-
-@node JMax1 Intrinsic
-@subsubsection JMax1 Intrinsic
-@cindex JMax1 intrinsic
-@cindex intrinsics, JMax1
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JMax1} to use this name for an
-external procedure.
-
-@node JMin0 Intrinsic
-@subsubsection JMin0 Intrinsic
-@cindex JMin0 intrinsic
-@cindex intrinsics, JMin0
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JMin0} to use this name for an
-external procedure.
-
-@node JMin1 Intrinsic
-@subsubsection JMin1 Intrinsic
-@cindex JMin1 intrinsic
-@cindex intrinsics, JMin1
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JMin1} to use this name for an
-external procedure.
-
-@node JMod Intrinsic
-@subsubsection JMod Intrinsic
-@cindex JMod intrinsic
-@cindex intrinsics, JMod
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JMod} to use this name for an
-external procedure.
-
-@node JNInt Intrinsic
-@subsubsection JNInt Intrinsic
-@cindex JNInt intrinsic
-@cindex intrinsics, JNInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JNInt} to use this name for an
-external procedure.
-
-@node JNot Intrinsic
-@subsubsection JNot Intrinsic
-@cindex JNot intrinsic
-@cindex intrinsics, JNot
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JNot} to use this name for an
-external procedure.
-
-@node JZExt Intrinsic
-@subsubsection JZExt Intrinsic
-@cindex JZExt intrinsic
-@cindex intrinsics, JZExt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL JZExt} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node Kill Intrinsic (subroutine)
-@subsubsection Kill Intrinsic (subroutine)
-@cindex Kill intrinsic
-@cindex intrinsics, Kill
-
-@noindent
-@example
-CALL Kill(@var{Pid}, @var{Signal}, @var{Status})
-@end example
-
-@noindent
-@var{Pid}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Signal}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sends the signal specified by @var{Signal} to the process @var{Pid}.
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-See @code{kill(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{Kill Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node Kill Intrinsic (function)
-@subsubsection Kill Intrinsic (function)
-@cindex Kill intrinsic
-@cindex intrinsics, Kill
-
-@noindent
-@example
-Kill(@var{Pid}, @var{Signal})
-@end example
-
-@noindent
-Kill: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Pid}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Signal}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Sends the signal specified by @var{Signal} to the process @var{Pid}.
-Returns 0 on success or a nonzero error code.
-See @code{kill(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{Kill Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node Kind Intrinsic
-@subsubsection Kind Intrinsic
-@cindex Kind intrinsic
-@cindex intrinsics, Kind
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Kind} to use this name for an
-external procedure.
-
-@node LBound Intrinsic
-@subsubsection LBound Intrinsic
-@cindex LBound intrinsic
-@cindex intrinsics, LBound
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL LBound} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Len Intrinsic
-@subsubsection Len Intrinsic
-@cindex Len intrinsic
-@cindex intrinsics, Len
-
-@noindent
-@example
-Len(@var{String})
-@end example
-
-@noindent
-Len: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{String}: @code{CHARACTER}; scalar.
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the length of @var{String}.
-
-If @var{String} is an array, the length of an element
-of @var{String} is returned.
-
-Note that @var{String} need not be defined when this
-intrinsic is invoked, since only the length, not
-the content, of @var{String} is needed.
-
-@xref{Bit_Size Intrinsic}, for the function that determines
-the size of its argument in bits.
-
-@end ifset
-@ifset familyF90
-@node Len_Trim Intrinsic
-@subsubsection Len_Trim Intrinsic
-@cindex Len_Trim intrinsic
-@cindex intrinsics, Len_Trim
-
-@noindent
-@example
-Len_Trim(@var{String})
-@end example
-
-@noindent
-Len_Trim: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f90}.
-
-@noindent
-Description:
-
-Returns the index of the last non-blank character in @var{String}.
-@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
-
-@end ifset
-@ifset familyF77
-@node LGe Intrinsic
-@subsubsection LGe Intrinsic
-@cindex LGe intrinsic
-@cindex intrinsics, LGe
-
-@noindent
-@example
-LGe(@var{String_A}, @var{String_B})
-@end example
-
-@noindent
-LGe: @code{LOGICAL(KIND=1)} function.
-
-@noindent
-@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{.TRUE.} if @samp{@var{String_A}.GE.@var{String_B}},
-@samp{.FALSE.} otherwise.
-@var{String_A} and @var{String_B} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{String_A} and @var{String_B} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-The lexical comparison intrinsics @code{LGe}, @code{LGt},
-@code{LLe}, and @code{LLt} differ from the corresponding
-intrinsic operators @code{.GE.}, @code{.GT.},
-@code{.LE.}, @code{.LT.}.
-Because the ASCII collating sequence is assumed,
-the following expressions always return @samp{.TRUE.}:
-
-@smallexample
-LGE ('0', ' ')
-LGE ('A', '0')
-LGE ('a', 'A')
-@end smallexample
-
-The following related expressions do @emph{not} always
-return @samp{.TRUE.}, as they are not necessarily evaluated
-assuming the arguments use ASCII encoding:
-
-@smallexample
-'0' .GE. ' '
-'A' .GE. '0'
-'a' .GE. 'A'
-@end smallexample
-
-The same difference exists
-between @code{LGt} and @code{.GT.};
-between @code{LLe} and @code{.LE.}; and
-between @code{LLt} and @code{.LT.}.
-
-@node LGt Intrinsic
-@subsubsection LGt Intrinsic
-@cindex LGt intrinsic
-@cindex intrinsics, LGt
-
-@noindent
-@example
-LGt(@var{String_A}, @var{String_B})
-@end example
-
-@noindent
-LGt: @code{LOGICAL(KIND=1)} function.
-
-@noindent
-@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{.TRUE.} if @samp{@var{String_A}.GT.@var{String_B}},
-@samp{.FALSE.} otherwise.
-@var{String_A} and @var{String_B} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{String_A} and @var{String_B} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-@xref{LGe Intrinsic}, for information on the distinction
-between the @code{LGT} intrinsic and the @code{.GT.}
-operator.
-
-@end ifset
-@ifset familyF2U
-@node Link Intrinsic (subroutine)
-@subsubsection Link Intrinsic (subroutine)
-@cindex Link intrinsic
-@cindex intrinsics, Link
-
-@noindent
-@example
-CALL Link(@var{Path1}, @var{Path2}, @var{Status})
-@end example
-
-@noindent
-@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Makes a (hard) link from file @var{Path1} to @var{Path2}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{Path1} and @var{Path2}---otherwise,
-trailing blanks in @var{Path1} and @var{Path2} are ignored.
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-See @code{link(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{Link Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node Link Intrinsic (function)
-@subsubsection Link Intrinsic (function)
-@cindex Link intrinsic
-@cindex intrinsics, Link
-
-@noindent
-@example
-Link(@var{Path1}, @var{Path2})
-@end example
-
-@noindent
-Link: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Makes a (hard) link from file @var{Path1} to @var{Path2}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{Path1} and @var{Path2}---otherwise,
-trailing blanks in @var{Path1} and @var{Path2} are ignored.
-Returns 0 on success or a nonzero error code.
-See @code{link(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{Link Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF77
-@node LLe Intrinsic
-@subsubsection LLe Intrinsic
-@cindex LLe intrinsic
-@cindex intrinsics, LLe
-
-@noindent
-@example
-LLe(@var{String_A}, @var{String_B})
-@end example
-
-@noindent
-LLe: @code{LOGICAL(KIND=1)} function.
-
-@noindent
-@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{.TRUE.} if @samp{@var{String_A}.LE.@var{String_B}},
-@samp{.FALSE.} otherwise.
-@var{String_A} and @var{String_B} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{String_A} and @var{String_B} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-@xref{LGe Intrinsic}, for information on the distinction
-between the @code{LLE} intrinsic and the @code{.LE.}
-operator.
-
-@node LLt Intrinsic
-@subsubsection LLt Intrinsic
-@cindex LLt intrinsic
-@cindex intrinsics, LLt
-
-@noindent
-@example
-LLt(@var{String_A}, @var{String_B})
-@end example
-
-@noindent
-LLt: @code{LOGICAL(KIND=1)} function.
-
-@noindent
-@var{String_A}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{String_B}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{.TRUE.} if @samp{@var{String_A}.LT.@var{String_B}},
-@samp{.FALSE.} otherwise.
-@var{String_A} and @var{String_B} are interpreted as containing
-ASCII character codes.
-If either value contains a character not in the ASCII
-character set, the result is processor dependent.
-
-If the @var{String_A} and @var{String_B} are not the same length,
-the shorter is compared as if spaces were appended to
-it to form a value that has the same length as the longer.
-
-@xref{LGe Intrinsic}, for information on the distinction
-between the @code{LLT} intrinsic and the @code{.LT.}
-operator.
-
-@end ifset
-@ifset familyF2U
-@node LnBlnk Intrinsic
-@subsubsection LnBlnk Intrinsic
-@cindex LnBlnk intrinsic
-@cindex intrinsics, LnBlnk
-
-@noindent
-@example
-LnBlnk(@var{String})
-@end example
-
-@noindent
-LnBlnk: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the index of the last non-blank character in @var{String}.
-@code{LNBLNK} and @code{LEN_TRIM} are equivalent.
-
-@node Loc Intrinsic
-@subsubsection Loc Intrinsic
-@cindex Loc intrinsic
-@cindex intrinsics, Loc
-
-@noindent
-@example
-Loc(@var{Entity})
-@end example
-
-@noindent
-Loc: @code{INTEGER(KIND=7)} function.
-
-@noindent
-@var{Entity}: Any type; cannot be a constant or expression.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-The @code{LOC()} intrinsic works the
-same way as the @code{%LOC()} construct.
-@xref{%LOC(),,The @code{%LOC()} Construct}, for
-more information.
-
-@end ifset
-@ifset familyF77
-@node Log Intrinsic
-@subsubsection Log Intrinsic
-@cindex Log intrinsic
-@cindex intrinsics, Log
-
-@noindent
-@example
-Log(@var{X})
-@end example
-
-@noindent
-Log: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the natural logarithm of @var{X}, which must
-be greater than zero or, if type @code{COMPLEX}, must not
-be zero.
-
-@xref{Exp Intrinsic}, for the inverse of this function.
-
-@xref{Log10 Intrinsic}, for the `common' (base-10) logarithm function.
-
-@node Log10 Intrinsic
-@subsubsection Log10 Intrinsic
-@cindex Log10 intrinsic
-@cindex intrinsics, Log10
-
-@noindent
-@example
-Log10(@var{X})
-@end example
-
-@noindent
-Log10: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the common logarithm (base 10) of @var{X}, which must
-be greater than zero.
-
-The inverse of this function is @samp{10. ** LOG10(@var{X})}.
-
-@xref{Log Intrinsic}, for the natural logarithm function.
-
-@end ifset
-@ifset familyF90
-@node Logical Intrinsic
-@subsubsection Logical Intrinsic
-@cindex Logical intrinsic
-@cindex intrinsics, Logical
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Logical} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node Long Intrinsic
-@subsubsection Long Intrinsic
-@cindex Long intrinsic
-@cindex intrinsics, Long
-
-@noindent
-@example
-Long(@var{A})
-@end example
-
-@noindent
-Long: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=6)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Archaic form of @code{INT()} that is specific
-to one type for @var{A}.
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-
-@end ifset
-@ifset familyF2C
-@node LShift Intrinsic
-@subsubsection LShift Intrinsic
-@cindex LShift intrinsic
-@cindex intrinsics, LShift
-
-@noindent
-@example
-LShift(@var{I}, @var{Shift})
-@end example
-
-@noindent
-LShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Returns @var{I} shifted to the left
-@var{Shift} bits.
-
-Although similar to the expression
-@samp{@var{I}*(2**@var{Shift})}, there
-are important differences.
-For example, the sign of the result is
-not necessarily the same as the sign of
-@var{I}.
-
-Currently this intrinsic is defined assuming
-the underlying representation of @var{I}
-is as a two's-complement integer.
-It is unclear at this point whether that
-definition will apply when a different
-representation is involved.
-
-@xref{LShift Intrinsic}, for the inverse of this function.
-
-@xref{IShft Intrinsic}, for information
-on a more widely available left-shifting
-intrinsic that is also more precisely defined.
-
-@end ifset
-@ifset familyF2U
-@node LStat Intrinsic (subroutine)
-@subsubsection LStat Intrinsic (subroutine)
-@cindex LStat intrinsic
-@cindex intrinsics, LStat
-
-@noindent
-@example
-CALL LStat(@var{File}, @var{SArray}, @var{Status})
-@end example
-
-@noindent
-@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Obtains data about the given file @var{File} and places them in the array
-@var{SArray}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{File}---otherwise,
-trailing blanks in @var{File} are ignored.
-If @var{File} is a symbolic link it returns data on the
-link itself, so the routine is available only on systems that support
-symbolic links.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{LStat Intrinsic (function)}.
-
-@node LStat Intrinsic (function)
-@subsubsection LStat Intrinsic (function)
-@cindex LStat intrinsic
-@cindex intrinsics, LStat
-
-@noindent
-@example
-LStat(@var{File}, @var{SArray})
-@end example
-
-@noindent
-LStat: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Obtains data about the given file @var{File} and places them in the array
-@var{SArray}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{File}---otherwise,
-trailing blanks in @var{File} are ignored.
-If @var{File} is a symbolic link it returns data on the
-link itself, so the routine is available only on systems that support
-symbolic links.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-Returns 0 on success or a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{lstat(2)}).
-
-For information on other intrinsics with the same name:
-@xref{LStat Intrinsic (subroutine)}.
-
-@node LTime Intrinsic
-@subsubsection LTime Intrinsic
-@cindex LTime intrinsic
-@cindex intrinsics, LTime
-
-@noindent
-@example
-CALL LTime(@var{STime}, @var{TArray})
-@end example
-
-@noindent
-@var{STime}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-@var{TArray}: @code{INTEGER(KIND=1)}; DIMENSION(9); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Given a system time value @var{STime}, fills @var{TArray} with values
-extracted from it appropriate to the GMT time zone using
-@code{localtime(3)}.
-
-The array elements are as follows:
-
-@enumerate
-@item
-Seconds after the minute, range 0--59 or 0--61 to allow for leap
-seconds
-
-@item
-Minutes after the hour, range 0--59
-
-@item
-Hours past midnight, range 0--23
-
-@item
-Day of month, range 0--31
-
-@item
-Number of months since January, range 0--12
-
-@item
-Years since 1900
-
-@item
-Number of days since Sunday, range 0--6
-
-@item
-Days since January 1
-
-@item
-Daylight savings indicator: positive if daylight savings is in effect,
-zero if not, and negative if the information isn't available.
-@end enumerate
-
-@end ifset
-@ifset familyF90
-@node MatMul Intrinsic
-@subsubsection MatMul Intrinsic
-@cindex MatMul intrinsic
-@cindex intrinsics, MatMul
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MatMul} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Max Intrinsic
-@subsubsection Max Intrinsic
-@cindex Max intrinsic
-@cindex intrinsics, Max
-
-@noindent
-@example
-Max(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-Max: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the argument with the largest value.
-
-@xref{Min Intrinsic}, for the opposite function.
-
-@node Max0 Intrinsic
-@subsubsection Max0 Intrinsic
-@cindex Max0 intrinsic
-@cindex intrinsics, Max0
-
-@noindent
-@example
-Max0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-Max0: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MAX()} that is specific
-to one type for @var{A}.
-@xref{Max Intrinsic}.
-
-@node Max1 Intrinsic
-@subsubsection Max1 Intrinsic
-@cindex Max1 intrinsic
-@cindex intrinsics, Max1
-
-@noindent
-@example
-Max1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-Max1: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MAX()} that is specific
-to one type for @var{A} and a different return type.
-@xref{Max Intrinsic}.
-
-@end ifset
-@ifset familyF90
-@node MaxExponent Intrinsic
-@subsubsection MaxExponent Intrinsic
-@cindex MaxExponent intrinsic
-@cindex intrinsics, MaxExponent
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MaxExponent} to use this name for an
-external procedure.
-
-@node MaxLoc Intrinsic
-@subsubsection MaxLoc Intrinsic
-@cindex MaxLoc intrinsic
-@cindex intrinsics, MaxLoc
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MaxLoc} to use this name for an
-external procedure.
-
-@node MaxVal Intrinsic
-@subsubsection MaxVal Intrinsic
-@cindex MaxVal intrinsic
-@cindex intrinsics, MaxVal
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MaxVal} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node MClock Intrinsic
-@subsubsection MClock Intrinsic
-@cindex MClock intrinsic
-@cindex intrinsics, MClock
-
-@noindent
-@example
-MClock()
-@end example
-
-@noindent
-MClock: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the number of clock ticks since the start of the process.
-Supported on systems with @code{clock(3)} (q.v.).
-
-@cindex wraparound, timings
-@cindex limits, timings
-This intrinsic is not fully portable, such as to systems
-with 32-bit @code{INTEGER} types but supporting times
-wider than 32 bits.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-@xref{MClock8 Intrinsic}, for information on a
-similar intrinsic that might be portable to more
-GNU Fortran implementations, though to fewer
-Fortran compilers.
-
-If the system does not support @code{clock(3)},
--1 is returned.
-
-@node MClock8 Intrinsic
-@subsubsection MClock8 Intrinsic
-@cindex MClock8 intrinsic
-@cindex intrinsics, MClock8
-
-@noindent
-@example
-MClock8()
-@end example
-
-@noindent
-MClock8: @code{INTEGER(KIND=2)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the number of clock ticks since the start of the process.
-Supported on systems with @code{clock(3)} (q.v.).
-
-@cindex wraparound, timings
-@cindex limits, timings
-@emph{Warning:} this intrinsic does not increase the range
-of the timing values over that returned by @code{clock(3)}.
-On a system with a 32-bit @code{clock(3)},
-@code{MCLOCK8} will return a 32-bit value,
-even though converted to an @samp{INTEGER(KIND=2)} value.
-That means overflows of the 32-bit value can still occur.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-No Fortran implementations other than GNU Fortran are
-known to support this intrinsic at the time of this
-writing.
-@xref{MClock Intrinsic}, for information on a
-similar intrinsic that might be portable to more Fortran
-compilers, though to fewer GNU Fortran implementations.
-
-If the system does not support @code{clock(3)},
--1 is returned.
-
-@end ifset
-@ifset familyF90
-@node Merge Intrinsic
-@subsubsection Merge Intrinsic
-@cindex Merge intrinsic
-@cindex intrinsics, Merge
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Merge} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Min Intrinsic
-@subsubsection Min Intrinsic
-@cindex Min intrinsic
-@cindex intrinsics, Min
-
-@noindent
-@example
-Min(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-Min: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{A}: @code{INTEGER} or @code{REAL}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the argument with the smallest value.
-
-@xref{Max Intrinsic}, for the opposite function.
-
-@node Min0 Intrinsic
-@subsubsection Min0 Intrinsic
-@cindex Min0 intrinsic
-@cindex intrinsics, Min0
-
-@noindent
-@example
-Min0(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-Min0: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{INTEGER(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MIN()} that is specific
-to one type for @var{A}.
-@xref{Min Intrinsic}.
-
-@node Min1 Intrinsic
-@subsubsection Min1 Intrinsic
-@cindex Min1 intrinsic
-@cindex intrinsics, Min1
-
-@noindent
-@example
-Min1(@var{A}-1, @var{A}-2, @dots{}, @var{A}-n)
-@end example
-
-@noindent
-Min1: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=1)}; at least two such arguments must be provided; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{MIN()} that is specific
-to one type for @var{A} and a different return type.
-@xref{Min Intrinsic}.
-
-@end ifset
-@ifset familyF90
-@node MinExponent Intrinsic
-@subsubsection MinExponent Intrinsic
-@cindex MinExponent intrinsic
-@cindex intrinsics, MinExponent
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MinExponent} to use this name for an
-external procedure.
-
-@node MinLoc Intrinsic
-@subsubsection MinLoc Intrinsic
-@cindex MinLoc intrinsic
-@cindex intrinsics, MinLoc
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MinLoc} to use this name for an
-external procedure.
-
-@node MinVal Intrinsic
-@subsubsection MinVal Intrinsic
-@cindex MinVal intrinsic
-@cindex intrinsics, MinVal
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL MinVal} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Mod Intrinsic
-@subsubsection Mod Intrinsic
-@cindex Mod intrinsic
-@cindex intrinsics, Mod
-
-@noindent
-@example
-Mod(@var{A}, @var{P})
-@end example
-
-@noindent
-Mod: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-@var{P}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns remainder calculated as:
-
-@smallexample
-@var{A} - (INT(@var{A} / @var{P}) * @var{P})
-@end smallexample
-
-@var{P} must not be zero.
-
-@end ifset
-@ifset familyF90
-@node Modulo Intrinsic
-@subsubsection Modulo Intrinsic
-@cindex Modulo intrinsic
-@cindex intrinsics, Modulo
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Modulo} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyMIL
-@node MvBits Intrinsic
-@subsubsection MvBits Intrinsic
-@cindex MvBits intrinsic
-@cindex intrinsics, MvBits
-
-@noindent
-@example
-CALL MvBits(@var{From}, @var{FromPos}, @var{Len}, @var{TO}, @var{ToPos})
-@end example
-
-@noindent
-@var{From}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{FromPos}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Len}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{TO}: @code{INTEGER} with same @samp{KIND=} value as for @var{From}; scalar; INTENT(INOUT).
-
-@noindent
-@var{ToPos}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Moves @var{Len} bits from positions @var{FromPos} through
-@samp{@var{FromPos}+@var{Len}-1} of @var{From} to positions @var{ToPos} through
-@samp{@var{FromPos}+@var{Len}-1} of @var{TO}.  The portion of argument
-@var{TO} not affected by the movement of bits is unchanged.  Arguments
-@var{From} and @var{TO} are permitted to be the same numeric storage
-unit.  The values of @samp{@var{FromPos}+@var{Len}} and
-@samp{@var{ToPos}+@var{Len}} must be less than or equal to
-@samp{BIT_SIZE(@var{From})}.
-
-@end ifset
-@ifset familyF90
-@node Nearest Intrinsic
-@subsubsection Nearest Intrinsic
-@cindex Nearest intrinsic
-@cindex intrinsics, Nearest
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Nearest} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node NInt Intrinsic
-@subsubsection NInt Intrinsic
-@cindex NInt intrinsic
-@cindex intrinsics, NInt
-
-@noindent
-@example
-NInt(@var{A})
-@end example
-
-@noindent
-NInt: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude eliminated by rounding to the nearest whole
-number and with its sign preserved, converted
-to type @code{INTEGER(KIND=1)}.
-
-If @var{A} is type @code{COMPLEX}, its real part is
-rounded and converted.
-
-A fractional portion exactly equal to
-@samp{.5} is rounded to the whole number that
-is larger in magnitude.
-(Also called ``Fortran round''.)
-
-@xref{Int Intrinsic}, for how to convert, truncate to
-whole number.
-
-@xref{ANInt Intrinsic}, for how to round to nearest whole number
-without converting.
-
-@end ifset
-@ifset familyMIL
-@node Not Intrinsic
-@subsubsection Not Intrinsic
-@cindex Not intrinsic
-@cindex intrinsics, Not
-
-@noindent
-@example
-Not(@var{I})
-@end example
-
-@noindent
-Not: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{mil}, @code{f90}, @code{vxt}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean NOT of each bit
-in @var{I}.
-
-@end ifset
-@ifset familyF2C
-@node Or Intrinsic
-@subsubsection Or Intrinsic
-@cindex Or intrinsic
-@cindex intrinsics, Or
-
-@noindent
-@example
-Or(@var{I}, @var{J})
-@end example
-
-@noindent
-Or: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
-
-@noindent
-@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean OR of
-pair of bits in each of @var{I} and @var{J}.
-
-@end ifset
-@ifset familyF90
-@node Pack Intrinsic
-@subsubsection Pack Intrinsic
-@cindex Pack intrinsic
-@cindex intrinsics, Pack
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Pack} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node PError Intrinsic
-@subsubsection PError Intrinsic
-@cindex PError intrinsic
-@cindex intrinsics, PError
-
-@noindent
-@example
-CALL PError(@var{String})
-@end example
-
-@noindent
-@var{String}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Prints (on the C @code{stderr} stream) a newline-terminated error
-message corresponding to the last system error.
-This is prefixed by @var{String}, a colon and a space.
-See @code{perror(3)}.
-
-@end ifset
-@ifset familyF90
-@node Precision Intrinsic
-@subsubsection Precision Intrinsic
-@cindex Precision intrinsic
-@cindex intrinsics, Precision
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Precision} to use this name for an
-external procedure.
-
-@node Present Intrinsic
-@subsubsection Present Intrinsic
-@cindex Present intrinsic
-@cindex intrinsics, Present
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Present} to use this name for an
-external procedure.
-
-@node Product Intrinsic
-@subsubsection Product Intrinsic
-@cindex Product intrinsic
-@cindex intrinsics, Product
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Product} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyVXT
-@node QAbs Intrinsic
-@subsubsection QAbs Intrinsic
-@cindex QAbs intrinsic
-@cindex intrinsics, QAbs
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QAbs} to use this name for an
-external procedure.
-
-@node QACos Intrinsic
-@subsubsection QACos Intrinsic
-@cindex QACos intrinsic
-@cindex intrinsics, QACos
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QACos} to use this name for an
-external procedure.
-
-@node QACosD Intrinsic
-@subsubsection QACosD Intrinsic
-@cindex QACosD intrinsic
-@cindex intrinsics, QACosD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QACosD} to use this name for an
-external procedure.
-
-@node QASin Intrinsic
-@subsubsection QASin Intrinsic
-@cindex QASin intrinsic
-@cindex intrinsics, QASin
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QASin} to use this name for an
-external procedure.
-
-@node QASinD Intrinsic
-@subsubsection QASinD Intrinsic
-@cindex QASinD intrinsic
-@cindex intrinsics, QASinD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QASinD} to use this name for an
-external procedure.
-
-@node QATan Intrinsic
-@subsubsection QATan Intrinsic
-@cindex QATan intrinsic
-@cindex intrinsics, QATan
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QATan} to use this name for an
-external procedure.
-
-@node QATan2 Intrinsic
-@subsubsection QATan2 Intrinsic
-@cindex QATan2 intrinsic
-@cindex intrinsics, QATan2
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QATan2} to use this name for an
-external procedure.
-
-@node QATan2D Intrinsic
-@subsubsection QATan2D Intrinsic
-@cindex QATan2D intrinsic
-@cindex intrinsics, QATan2D
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QATan2D} to use this name for an
-external procedure.
-
-@node QATanD Intrinsic
-@subsubsection QATanD Intrinsic
-@cindex QATanD intrinsic
-@cindex intrinsics, QATanD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QATanD} to use this name for an
-external procedure.
-
-@node QCos Intrinsic
-@subsubsection QCos Intrinsic
-@cindex QCos intrinsic
-@cindex intrinsics, QCos
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QCos} to use this name for an
-external procedure.
-
-@node QCosD Intrinsic
-@subsubsection QCosD Intrinsic
-@cindex QCosD intrinsic
-@cindex intrinsics, QCosD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QCosD} to use this name for an
-external procedure.
-
-@node QCosH Intrinsic
-@subsubsection QCosH Intrinsic
-@cindex QCosH intrinsic
-@cindex intrinsics, QCosH
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QCosH} to use this name for an
-external procedure.
-
-@node QDiM Intrinsic
-@subsubsection QDiM Intrinsic
-@cindex QDiM intrinsic
-@cindex intrinsics, QDiM
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QDiM} to use this name for an
-external procedure.
-
-@node QExp Intrinsic
-@subsubsection QExp Intrinsic
-@cindex QExp intrinsic
-@cindex intrinsics, QExp
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QExp} to use this name for an
-external procedure.
-
-@node QExt Intrinsic
-@subsubsection QExt Intrinsic
-@cindex QExt intrinsic
-@cindex intrinsics, QExt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QExt} to use this name for an
-external procedure.
-
-@node QExtD Intrinsic
-@subsubsection QExtD Intrinsic
-@cindex QExtD intrinsic
-@cindex intrinsics, QExtD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QExtD} to use this name for an
-external procedure.
-
-@node QFloat Intrinsic
-@subsubsection QFloat Intrinsic
-@cindex QFloat intrinsic
-@cindex intrinsics, QFloat
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QFloat} to use this name for an
-external procedure.
-
-@node QInt Intrinsic
-@subsubsection QInt Intrinsic
-@cindex QInt intrinsic
-@cindex intrinsics, QInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QInt} to use this name for an
-external procedure.
-
-@node QLog Intrinsic
-@subsubsection QLog Intrinsic
-@cindex QLog intrinsic
-@cindex intrinsics, QLog
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QLog} to use this name for an
-external procedure.
-
-@node QLog10 Intrinsic
-@subsubsection QLog10 Intrinsic
-@cindex QLog10 intrinsic
-@cindex intrinsics, QLog10
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QLog10} to use this name for an
-external procedure.
-
-@node QMax1 Intrinsic
-@subsubsection QMax1 Intrinsic
-@cindex QMax1 intrinsic
-@cindex intrinsics, QMax1
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QMax1} to use this name for an
-external procedure.
-
-@node QMin1 Intrinsic
-@subsubsection QMin1 Intrinsic
-@cindex QMin1 intrinsic
-@cindex intrinsics, QMin1
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QMin1} to use this name for an
-external procedure.
-
-@node QMod Intrinsic
-@subsubsection QMod Intrinsic
-@cindex QMod intrinsic
-@cindex intrinsics, QMod
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QMod} to use this name for an
-external procedure.
-
-@node QNInt Intrinsic
-@subsubsection QNInt Intrinsic
-@cindex QNInt intrinsic
-@cindex intrinsics, QNInt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QNInt} to use this name for an
-external procedure.
-
-@node QSin Intrinsic
-@subsubsection QSin Intrinsic
-@cindex QSin intrinsic
-@cindex intrinsics, QSin
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QSin} to use this name for an
-external procedure.
-
-@node QSinD Intrinsic
-@subsubsection QSinD Intrinsic
-@cindex QSinD intrinsic
-@cindex intrinsics, QSinD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QSinD} to use this name for an
-external procedure.
-
-@node QSinH Intrinsic
-@subsubsection QSinH Intrinsic
-@cindex QSinH intrinsic
-@cindex intrinsics, QSinH
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QSinH} to use this name for an
-external procedure.
-
-@node QSqRt Intrinsic
-@subsubsection QSqRt Intrinsic
-@cindex QSqRt intrinsic
-@cindex intrinsics, QSqRt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QSqRt} to use this name for an
-external procedure.
-
-@node QTan Intrinsic
-@subsubsection QTan Intrinsic
-@cindex QTan intrinsic
-@cindex intrinsics, QTan
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QTan} to use this name for an
-external procedure.
-
-@node QTanD Intrinsic
-@subsubsection QTanD Intrinsic
-@cindex QTanD intrinsic
-@cindex intrinsics, QTanD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QTanD} to use this name for an
-external procedure.
-
-@node QTanH Intrinsic
-@subsubsection QTanH Intrinsic
-@cindex QTanH intrinsic
-@cindex intrinsics, QTanH
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL QTanH} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node Radix Intrinsic
-@subsubsection Radix Intrinsic
-@cindex Radix intrinsic
-@cindex intrinsics, Radix
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Radix} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node Rand Intrinsic
-@subsubsection Rand Intrinsic
-@cindex Rand intrinsic
-@cindex intrinsics, Rand
-
-@noindent
-@example
-Rand(@var{Flag})
-@end example
-
-@noindent
-Rand: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{Flag}: @code{INTEGER}; OPTIONAL; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns a uniform quasi-random number between 0 and 1.
-If @var{Flag} is 0, the next number in sequence is returned; if
-@var{Flag} is 1, the generator is restarted by calling @samp{srand(0)};
-if @var{Flag} has any other value, it is used as a new seed with
-@code{srand}.
-
-@xref{SRand Intrinsic}.
-
-@emph{Note:} As typically implemented (by the routine of the same
-name in the C library), this random number generator is a very poor
-one, though the BSD and GNU libraries provide a much better
-implementation than the `traditional' one.
-On a different system you
-almost certainly want to use something better.
-
-@end ifset
-@ifset familyF90
-@node Random_Number Intrinsic
-@subsubsection Random_Number Intrinsic
-@cindex Random_Number intrinsic
-@cindex intrinsics, Random_Number
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Random_Number} to use this name for an
-external procedure.
-
-@node Random_Seed Intrinsic
-@subsubsection Random_Seed Intrinsic
-@cindex Random_Seed intrinsic
-@cindex intrinsics, Random_Seed
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Random_Seed} to use this name for an
-external procedure.
-
-@node Range Intrinsic
-@subsubsection Range Intrinsic
-@cindex Range intrinsic
-@cindex intrinsics, Range
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Range} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node Real Intrinsic
-@subsubsection Real Intrinsic
-@cindex Real intrinsic
-@cindex intrinsics, Real
-
-@noindent
-@example
-Real(@var{A})
-@end example
-
-@noindent
-Real: @code{REAL} function.
-The exact type is @samp{REAL(KIND=1)} when argument @var{A} is
-any type other than @code{COMPLEX}, or when it is @code{COMPLEX(KIND=1)}.
-When @var{A} is any @code{COMPLEX} type other than @code{COMPLEX(KIND=1)},
-this intrinsic is valid only when used as the argument to
-@code{REAL()}, as explained below.
-
-@noindent
-@var{A}: @code{INTEGER}, @code{REAL}, or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Converts @var{A} to @code{REAL(KIND=1)}.
-
-Use of @code{REAL()} with a @code{COMPLEX} argument
-(other than @code{COMPLEX(KIND=1)}) is restricted to the following case:
-
-@example
-REAL(REAL(A))
-@end example
-
-@noindent
-This expression converts the real part of A to
-@code{REAL(KIND=1)}.
-
-@xref{RealPart Intrinsic}, for information on a GNU Fortran
-intrinsic that extracts the real part of an arbitrary
-@code{COMPLEX} value.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-
-@end ifset
-@ifset familyGNU
-@node RealPart Intrinsic
-@subsubsection RealPart Intrinsic
-@cindex RealPart intrinsic
-@cindex intrinsics, RealPart
-
-@noindent
-@example
-RealPart(@var{Z})
-@end example
-
-@noindent
-RealPart: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{Z}.
-
-@noindent
-@var{Z}: @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{gnu}.
-
-@noindent
-Description:
-
-The real part of @var{Z} is returned, without conversion.
-
-@emph{Note:} The way to do this in standard Fortran 90
-is @samp{REAL(@var{Z})}.
-However, when, for example, @var{Z} is @code{COMPLEX(KIND=2)},
-@samp{REAL(@var{Z})} means something different for some compilers
-that are not true Fortran 90 compilers but offer some
-extensions standardized by Fortran 90 (such as the
-@code{DOUBLE COMPLEX} type, also known as @code{COMPLEX(KIND=2)}).
-
-The advantage of @code{REALPART()} is that, while not necessarily
-more or less portable than @code{REAL()}, it is more likely to
-cause a compiler that doesn't support it to produce a diagnostic
-than generate incorrect code.
-
-@xref{REAL() and AIMAG() of Complex}, for more information.
-
-@end ifset
-@ifset familyF2U
-@node Rename Intrinsic (subroutine)
-@subsubsection Rename Intrinsic (subroutine)
-@cindex Rename intrinsic
-@cindex intrinsics, Rename
-
-@noindent
-@example
-CALL Rename(@var{Path1}, @var{Path2}, @var{Status})
-@end example
-
-@noindent
-@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Renames the file @var{Path1} to @var{Path2}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{Path1} and @var{Path2}---otherwise,
-trailing blanks in @var{Path1} and @var{Path2} are ignored.
-See @code{rename(2)}.
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{Rename Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node Rename Intrinsic (function)
-@subsubsection Rename Intrinsic (function)
-@cindex Rename intrinsic
-@cindex intrinsics, Rename
-
-@noindent
-@example
-Rename(@var{Path1}, @var{Path2})
-@end example
-
-@noindent
-Rename: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Renames the file @var{Path1} to @var{Path2}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{Path1} and @var{Path2}---otherwise,
-trailing blanks in @var{Path1} and @var{Path2} are ignored.
-See @code{rename(2)}.
-Returns 0 on success or a nonzero error code.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{Rename Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node Repeat Intrinsic
-@subsubsection Repeat Intrinsic
-@cindex Repeat intrinsic
-@cindex intrinsics, Repeat
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Repeat} to use this name for an
-external procedure.
-
-@node Reshape Intrinsic
-@subsubsection Reshape Intrinsic
-@cindex Reshape intrinsic
-@cindex intrinsics, Reshape
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Reshape} to use this name for an
-external procedure.
-
-@node RRSpacing Intrinsic
-@subsubsection RRSpacing Intrinsic
-@cindex RRSpacing intrinsic
-@cindex intrinsics, RRSpacing
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL RRSpacing} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2C
-@node RShift Intrinsic
-@subsubsection RShift Intrinsic
-@cindex RShift intrinsic
-@cindex intrinsics, RShift
-
-@noindent
-@example
-RShift(@var{I}, @var{Shift})
-@end example
-
-@noindent
-RShift: @code{INTEGER} function, the @samp{KIND=} value of the type being that of argument @var{I}.
-
-@noindent
-@var{I}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Shift}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Returns @var{I} shifted to the right
-@var{Shift} bits.
-
-Although similar to the expression
-@samp{@var{I}/(2**@var{Shift})}, there
-are important differences.
-For example, the sign of the result is
-undefined.
-
-Currently this intrinsic is defined assuming
-the underlying representation of @var{I}
-is as a two's-complement integer.
-It is unclear at this point whether that
-definition will apply when a different
-representation is involved.
-
-@xref{RShift Intrinsic}, for the inverse of this function.
-
-@xref{IShft Intrinsic}, for information
-on a more widely available right-shifting
-intrinsic that is also more precisely defined.
-
-@end ifset
-@ifset familyF90
-@node Scale Intrinsic
-@subsubsection Scale Intrinsic
-@cindex Scale intrinsic
-@cindex intrinsics, Scale
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Scale} to use this name for an
-external procedure.
-
-@node Scan Intrinsic
-@subsubsection Scan Intrinsic
-@cindex Scan intrinsic
-@cindex intrinsics, Scan
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Scan} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyVXT
-@node Secnds Intrinsic
-@subsubsection Secnds Intrinsic
-@cindex Secnds intrinsic
-@cindex intrinsics, Secnds
-
-@noindent
-@example
-Secnds(@var{T})
-@end example
-
-@noindent
-Secnds: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{T}: @code{REAL(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{vxt}.
-
-@noindent
-Description:
-
-Returns the local time in seconds since midnight minus the value
-@var{T}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-This values returned by this intrinsic
-become numerically less than previous values
-(they wrap around) during a single run of the
-compiler program, under normal circumstances
-(such as running through the midnight hour).
-
-@end ifset
-@ifset familyF2U
-@node Second Intrinsic (function)
-@subsubsection Second Intrinsic (function)
-@cindex Second intrinsic
-@cindex intrinsics, Second
-
-@noindent
-@example
-Second()
-@end example
-
-@noindent
-Second: @code{REAL(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the process's runtime in seconds---the same value as the
-UNIX function @code{etime} returns.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-For information on other intrinsics with the same name:
-@xref{Second Intrinsic (subroutine)}.
-
-@node Second Intrinsic (subroutine)
-@subsubsection Second Intrinsic (subroutine)
-@cindex Second intrinsic
-@cindex intrinsics, Second
-
-@noindent
-@example
-CALL Second(@var{Seconds})
-@end example
-
-@noindent
-@var{Seconds}: @code{REAL}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the process's runtime in seconds in @var{Seconds}---the same value
-as the UNIX function @code{etime} returns.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-This routine is known from Cray Fortran.  @xref{CPU_Time Intrinsic},
-for a standard equivalent.
-
-For information on other intrinsics with the same name:
-@xref{Second Intrinsic (function)}.
-
-@end ifset
-@ifset familyF90
-@node Selected_Int_Kind Intrinsic
-@subsubsection Selected_Int_Kind Intrinsic
-@cindex Selected_Int_Kind intrinsic
-@cindex intrinsics, Selected_Int_Kind
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Selected_Int_Kind} to use this name for an
-external procedure.
-
-@node Selected_Real_Kind Intrinsic
-@subsubsection Selected_Real_Kind Intrinsic
-@cindex Selected_Real_Kind intrinsic
-@cindex intrinsics, Selected_Real_Kind
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Selected_Real_Kind} to use this name for an
-external procedure.
-
-@node Set_Exponent Intrinsic
-@subsubsection Set_Exponent Intrinsic
-@cindex Set_Exponent intrinsic
-@cindex intrinsics, Set_Exponent
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Set_Exponent} to use this name for an
-external procedure.
-
-@node Shape Intrinsic
-@subsubsection Shape Intrinsic
-@cindex Shape intrinsic
-@cindex intrinsics, Shape
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Shape} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node Short Intrinsic
-@subsubsection Short Intrinsic
-@cindex Short intrinsic
-@cindex intrinsics, Short
-
-@noindent
-@example
-Short(@var{A})
-@end example
-
-@noindent
-Short: @code{INTEGER(KIND=6)} function.
-
-@noindent
-@var{A}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns @var{A} with the fractional portion of its
-magnitude truncated and its sign preserved, converted
-to type @code{INTEGER(KIND=6)}.
-
-If @var{A} is type @code{COMPLEX}, its real part
-is truncated and converted, and its imaginary part is disregarded.
-
-@xref{Int Intrinsic}.
-
-The precise meaning of this intrinsic might change
-in a future version of the GNU Fortran language,
-as more is learned about how it is used.
-
-@end ifset
-@ifset familyF77
-@node Sign Intrinsic
-@subsubsection Sign Intrinsic
-@cindex Sign intrinsic
-@cindex intrinsics, Sign
-
-@noindent
-@example
-Sign(@var{A}, @var{B})
-@end example
-
-@noindent
-Sign: @code{INTEGER} or @code{REAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{A}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-@var{B}: @code{INTEGER} or @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns @samp{ABS(@var{A})*@var{s}}, where
-@var{s} is +1 if @samp{@var{B}.GE.0},
--1 otherwise.
-
-@xref{Abs Intrinsic}, for the function that returns
-the magnitude of a value.
-
-@end ifset
-@ifset familyF2U
-@node Signal Intrinsic (subroutine)
-@subsubsection Signal Intrinsic (subroutine)
-@cindex Signal intrinsic
-@cindex intrinsics, Signal
-
-@noindent
-@example
-CALL Signal(@var{Number}, @var{Handler}, @var{Status})
-@end example
-
-@noindent
-@var{Number}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
-or dummy/global @code{INTEGER(KIND=1)} scalar.
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=7)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be
-invoked with a single integer argument (of system-dependent length)
-when signal @var{Number} occurs.
-If @var{Handler} is an integer, it can be
-used to turn off handling of signal @var{Number} or revert to its default
-action.
-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 @code{LOC()}) to it.
-
-The value returned by @code{signal(2)} is written to @var{Status}, if
-that argument is supplied.
-Otherwise the return value is ignored.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-@emph{Warning:} Use of the @code{libf2c} run-time library function
-@samp{signal_} directly
-(such as via @samp{EXTERNAL SIGNAL})
-requires use of the @code{%VAL()} construct
-to pass an @code{INTEGER} value
-(such as @samp{SIG_IGN} or @samp{SIG_DFL})
-for the @var{Handler} argument.
-
-However, while @samp{CALL SIGNAL(@var{signum}, %VAL(SIG_IGN))}
-works when @samp{SIGNAL} is treated as an external procedure
-(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
-this construct is not valid when @samp{SIGNAL} is recognized
-as the intrinsic of that name.
-
-Therefore, for maximum portability and reliability,
-code such references to the @samp{SIGNAL} facility as follows:
-
-@smallexample
-INTRINSIC SIGNAL
-@dots{}
-CALL SIGNAL(@var{signum}, SIG_IGN)
-@end smallexample
-
-@code{g77} will compile such a call correctly,
-while other compilers will generally either do so as well
-or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
-allowing you to take appropriate action.
-
-For information on other intrinsics with the same name:
-@xref{Signal Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node Signal Intrinsic (function)
-@subsubsection Signal Intrinsic (function)
-@cindex Signal intrinsic
-@cindex intrinsics, Signal
-
-@noindent
-@example
-Signal(@var{Number}, @var{Handler})
-@end example
-
-@noindent
-Signal: @code{INTEGER(KIND=7)} function.
-
-@noindent
-@var{Number}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Handler}: Signal handler (@code{INTEGER FUNCTION} or @code{SUBROUTINE})
-or dummy/global @code{INTEGER(KIND=1)} scalar.
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-If @var{Handler} is a an @code{EXTERNAL} routine, arranges for it to be
-invoked with a single integer argument (of system-dependent length)
-when signal @var{Number} occurs.
-If @var{Handler} is an integer, it can be
-used to turn off handling of signal @var{Number} or revert to its default
-action.
-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 @code{LOC()}) to it.
-
-The value returned by @code{signal(2)} is returned.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-@emph{Warning:} If the returned value is stored in
-an @code{INTEGER(KIND=1)} (default @code{INTEGER}) argument,
-truncation of the original return value occurs on some systems
-(such as Alphas, which have 64-bit pointers but 32-bit default integers),
-with no warning issued by @code{g77} under normal circumstances.
-
-Therefore, the following code fragment might silently fail on
-some systems:
-
-@smallexample
-INTEGER RTN
-EXTERNAL MYHNDL
-RTN = SIGNAL(@var{signum}, MYHNDL)
-@dots{}
-! Restore original handler:
-RTN = SIGNAL(@var{signum}, RTN)
-@end smallexample
-
-The reason for the failure is that @samp{RTN} might not hold
-all the information on the original handler for the signal,
-thus restoring an invalid handler.
-This bug could manifest itself as a spurious run-time failure
-at an arbitrary point later during the program's execution,
-for example.
-
-@emph{Warning:} Use of the @code{libf2c} run-time library function
-@samp{signal_} directly
-(such as via @samp{EXTERNAL SIGNAL})
-requires use of the @code{%VAL()} construct
-to pass an @code{INTEGER} value
-(such as @samp{SIG_IGN} or @samp{SIG_DFL})
-for the @var{Handler} argument.
-
-However, while @samp{RTN = SIGNAL(@var{signum}, %VAL(SIG_IGN))}
-works when @samp{SIGNAL} is treated as an external procedure
-(and resolves, at link time, to @code{libf2c}'s @samp{signal_} routine),
-this construct is not valid when @samp{SIGNAL} is recognized
-as the intrinsic of that name.
-
-Therefore, for maximum portability and reliability,
-code such references to the @samp{SIGNAL} facility as follows:
-
-@smallexample
-INTRINSIC SIGNAL
-@dots{}
-RTN = SIGNAL(@var{signum}, SIG_IGN)
-@end smallexample
-
-@code{g77} will compile such a call correctly,
-while other compilers will generally either do so as well
-or reject the @samp{INTRINSIC SIGNAL} statement via a diagnostic,
-allowing you to take appropriate action.
-
-For information on other intrinsics with the same name:
-@xref{Signal Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF77
-@node Sin Intrinsic
-@subsubsection Sin Intrinsic
-@cindex Sin intrinsic
-@cindex intrinsics, Sin
-
-@noindent
-@example
-Sin(@var{X})
-@end example
-
-@noindent
-Sin: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the sine of @var{X}, an angle measured
-in radians.
-
-@xref{ASin Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyVXT
-@node SinD Intrinsic
-@subsubsection SinD Intrinsic
-@cindex SinD intrinsic
-@cindex intrinsics, SinD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL SinD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node SinH Intrinsic
-@subsubsection SinH Intrinsic
-@cindex SinH intrinsic
-@cindex intrinsics, SinH
-
-@noindent
-@example
-SinH(@var{X})
-@end example
-
-@noindent
-SinH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the hyperbolic sine of @var{X}.
-
-@end ifset
-@ifset familyF2U
-@node Sleep Intrinsic
-@subsubsection Sleep Intrinsic
-@cindex Sleep intrinsic
-@cindex intrinsics, Sleep
-
-@noindent
-@example
-CALL Sleep(@var{Seconds})
-@end example
-
-@noindent
-@var{Seconds}: @code{INTEGER(KIND=1)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Causes the process to pause for @var{Seconds} seconds.
-See @code{sleep(2)}.
-
-@end ifset
-@ifset familyF77
-@node Sngl Intrinsic
-@subsubsection Sngl Intrinsic
-@cindex Sngl intrinsic
-@cindex intrinsics, Sngl
-
-@noindent
-@example
-Sngl(@var{A})
-@end example
-
-@noindent
-Sngl: @code{REAL(KIND=1)} function.
-
-@noindent
-@var{A}: @code{REAL(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Archaic form of @code{REAL()} that is specific
-to one type for @var{A}.
-@xref{Real Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node SnglQ Intrinsic
-@subsubsection SnglQ Intrinsic
-@cindex SnglQ intrinsic
-@cindex intrinsics, SnglQ
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL SnglQ} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF90
-@node Spacing Intrinsic
-@subsubsection Spacing Intrinsic
-@cindex Spacing intrinsic
-@cindex intrinsics, Spacing
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Spacing} to use this name for an
-external procedure.
-
-@node Spread Intrinsic
-@subsubsection Spread Intrinsic
-@cindex Spread intrinsic
-@cindex intrinsics, Spread
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Spread} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node SqRt Intrinsic
-@subsubsection SqRt Intrinsic
-@cindex SqRt intrinsic
-@cindex intrinsics, SqRt
-
-@noindent
-@example
-SqRt(@var{X})
-@end example
-
-@noindent
-SqRt: @code{REAL} or @code{COMPLEX} function, the exact type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL} or @code{COMPLEX}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the square root of @var{X}, which must
-not be negative.
-
-To calculate and represent the square root of a negative
-number, complex arithmetic must be used.
-For example, @samp{SQRT(COMPLEX(@var{X}))}.
-
-The inverse of this function is @samp{SQRT(@var{X}) * SQRT(@var{X})}.
-
-@end ifset
-@ifset familyF2U
-@node SRand Intrinsic
-@subsubsection SRand Intrinsic
-@cindex SRand intrinsic
-@cindex intrinsics, SRand
-
-@noindent
-@example
-CALL SRand(@var{Seed})
-@end example
-
-@noindent
-@var{Seed}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Reinitializes the generator with the seed in @var{Seed}.
-@xref{IRand Intrinsic}.
-@xref{Rand Intrinsic}.
-
-@node Stat Intrinsic (subroutine)
-@subsubsection Stat Intrinsic (subroutine)
-@cindex Stat intrinsic
-@cindex intrinsics, Stat
-
-@noindent
-@example
-CALL Stat(@var{File}, @var{SArray}, @var{Status})
-@end example
-
-@noindent
-@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Obtains data about the given file @var{File} and places them in the array
-@var{SArray}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{File}---otherwise,
-trailing blanks in @var{File} are ignored.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{Stat Intrinsic (function)}.
-
-@node Stat Intrinsic (function)
-@subsubsection Stat Intrinsic (function)
-@cindex Stat intrinsic
-@cindex intrinsics, Stat
-
-@noindent
-@example
-Stat(@var{File}, @var{SArray})
-@end example
-
-@noindent
-Stat: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{SArray}: @code{INTEGER(KIND=1)}; DIMENSION(13); INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Obtains data about the given file @var{File} and places them in the array
-@var{SArray}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{File}---otherwise,
-trailing blanks in @var{File} are ignored.
-The values in this array are extracted from the
-@code{stat} structure as returned by @code{fstat(2)} q.v., as follows:
-
-@enumerate
-@item
-Device ID
-
-@item
-Inode number
-
-@item
-File mode
-
-@item
-Number of links
-
-@item
-Owner's uid
-
-@item
-Owner's gid
-
-@item
-ID of device containing directory entry for file
-(0 if not available)
-
-@item
-File size (bytes)
-
-@item
-Last access time
-
-@item
-Last modification time
-
-@item
-Last file status change time
-
-@item
-Preferred I/O block size (-1 if not available)
-
-@item
-Number of blocks allocated (-1 if not available)
-@end enumerate
-
-Not all these elements are relevant on all systems.
-If an element is not relevant, it is returned as 0.
-
-Returns 0 on success or a nonzero error code.
-
-For information on other intrinsics with the same name:
-@xref{Stat Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node Sum Intrinsic
-@subsubsection Sum Intrinsic
-@cindex Sum intrinsic
-@cindex intrinsics, Sum
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Sum} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node SymLnk Intrinsic (subroutine)
-@subsubsection SymLnk Intrinsic (subroutine)
-@cindex SymLnk intrinsic
-@cindex intrinsics, SymLnk
-
-@noindent
-@example
-CALL SymLnk(@var{Path1}, @var{Path2}, @var{Status})
-@end example
-
-@noindent
-@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Makes a symbolic link from file @var{Path1} to @var{Path2}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{Path1} and @var{Path2}---otherwise,
-trailing blanks in @var{Path1} and @var{Path2} are ignored.
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return
-(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{SymLnk Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node SymLnk Intrinsic (function)
-@subsubsection SymLnk Intrinsic (function)
-@cindex SymLnk intrinsic
-@cindex intrinsics, SymLnk
-
-@noindent
-@example
-SymLnk(@var{Path1}, @var{Path2})
-@end example
-
-@noindent
-SymLnk: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Path1}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Path2}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Makes a symbolic link from file @var{Path1} to @var{Path2}.
-A null character (@samp{CHAR(0)}) marks the end of
-the names in @var{Path1} and @var{Path2}---otherwise,
-trailing blanks in @var{Path1} and @var{Path2} are ignored.
-Returns 0 on success or a nonzero error code
-(@code{ENOSYS} if the system does not provide @code{symlink(2)}).
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{SymLnk Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF2U
-@node System Intrinsic (subroutine)
-@subsubsection System Intrinsic (subroutine)
-@cindex System intrinsic
-@cindex intrinsics, System
-
-@noindent
-@example
-CALL System(@var{Command}, @var{Status})
-@end example
-
-@noindent
-@var{Command}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Passes the command @var{Command} to a shell (see @code{system(3)}).
-If argument @var{Status} is present, it contains the value returned by
-@code{system(3)}, presumably 0 if the shell command succeeded.
-Note that which shell is used to invoke the command is system-dependent
-and environment-dependent.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{System Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node System Intrinsic (function)
-@subsubsection System Intrinsic (function)
-@cindex System intrinsic
-@cindex intrinsics, System
-
-@noindent
-@example
-System(@var{Command})
-@end example
-
-@noindent
-System: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Command}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Passes the command @var{Command} to a shell (see @code{system(3)}).
-Returns the value returned by
-@code{system(3)}, presumably 0 if the shell command succeeded.
-Note that which shell is used to invoke the command is system-dependent
-and environment-dependent.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-However, the function form can be valid in cases where the
-actual side effects performed by the call are unimportant to
-the application.
-
-For example, on a UNIX system, @samp{SAME = SYSTEM('cmp a b')}
-does not perform any side effects likely to be important to the
-program, so the programmer would not care if the actual system
-call (and invocation of @code{cmp}) was optimized away in a situation
-where the return value could be determined otherwise, or was not
-actually needed (@samp{SAME} not actually referenced after the
-sample assignment statement).
-
-For information on other intrinsics with the same name:
-@xref{System Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node System_Clock Intrinsic
-@subsubsection System_Clock Intrinsic
-@cindex System_Clock intrinsic
-@cindex intrinsics, System_Clock
-
-@noindent
-@example
-CALL System_Clock(@var{Count}, @var{Rate}, @var{Max})
-@end example
-
-@noindent
-@var{Count}: @code{INTEGER(KIND=1)}; scalar; INTENT(OUT).
-
-@noindent
-@var{Rate}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-@var{Max}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{f90}.
-
-@noindent
-Description:
-
-Returns in @var{Count} the current value of the system clock; this is
-the value returned by the UNIX function @code{times(2)}
-in this implementation, but
-isn't in general.
-@var{Rate} is the number of clock ticks per second and
-@var{Max} is the maximum value this can take, which isn't very useful
-in this implementation since it's just the maximum C @code{unsigned
-int} value.
-
-@cindex wraparound, timings
-@cindex limits, timings
-On some systems, the underlying timings are represented
-using types with sufficiently small limits that overflows
-(wraparounds) are possible, such as 32-bit types.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-@end ifset
-@ifset familyF77
-@node Tan Intrinsic
-@subsubsection Tan Intrinsic
-@cindex Tan intrinsic
-@cindex intrinsics, Tan
-
-@noindent
-@example
-Tan(@var{X})
-@end example
-
-@noindent
-Tan: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the tangent of @var{X}, an angle measured
-in radians.
-
-@xref{ATan Intrinsic}, for the inverse of this function.
-
-@end ifset
-@ifset familyVXT
-@node TanD Intrinsic
-@subsubsection TanD Intrinsic
-@cindex TanD intrinsic
-@cindex intrinsics, TanD
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL TanD} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF77
-@node TanH Intrinsic
-@subsubsection TanH Intrinsic
-@cindex TanH intrinsic
-@cindex intrinsics, TanH
-
-@noindent
-@example
-TanH(@var{X})
-@end example
-
-@noindent
-TanH: @code{REAL} function, the @samp{KIND=} value of the type being that of argument @var{X}.
-
-@noindent
-@var{X}: @code{REAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: (standard FORTRAN 77).
-
-@noindent
-Description:
-
-Returns the hyperbolic tangent of @var{X}.
-
-@end ifset
-@ifset familyF2U
-@node Time Intrinsic (UNIX)
-@subsubsection Time Intrinsic (UNIX)
-@cindex Time intrinsic
-@cindex intrinsics, Time
-
-@noindent
-@example
-Time()
-@end example
-
-@noindent
-Time: @code{INTEGER(KIND=1)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the current time encoded as an integer
-(in the manner of the UNIX function @code{time(3)}).
-This value is suitable for passing to @code{CTIME},
-@code{GMTIME}, and @code{LTIME}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-This intrinsic is not fully portable, such as to systems
-with 32-bit @code{INTEGER} types but supporting times
-wider than 32 bits.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-@xref{Time8 Intrinsic}, for information on a
-similar intrinsic that might be portable to more
-GNU Fortran implementations, though to fewer
-Fortran compilers.
-
-For information on other intrinsics with the same name:
-@xref{Time Intrinsic (VXT)}.
-
-@end ifset
-@ifset familyVXT
-@node Time Intrinsic (VXT)
-@subsubsection Time Intrinsic (VXT)
-@cindex Time intrinsic
-@cindex intrinsics, Time
-
-@noindent
-@example
-CALL Time(@var{Time})
-@end example
-
-@noindent
-@var{Time}: @code{CHARACTER*8}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{vxt}.
-
-@noindent
-Description:
-
-Returns in @var{Time} a character representation of the current time as
-obtained from @code{ctime(3)}.
-
-@cindex Y10K compliance
-@cindex Year 10000 compliance
-@cindex wraparound, Y10K
-@cindex limits, Y10K
-Programs making use of this intrinsic
-might not be Year 10000 (Y10K) compliant.
-For example, the date might appear,
-to such programs, to wrap around
-(change from a larger value to a smaller one)
-as of the Year 10000.
-
-@xref{FDate Intrinsic (subroutine)}, for an equivalent routine.
-
-For information on other intrinsics with the same name:
-@xref{Time Intrinsic (UNIX)}.
-
-@end ifset
-@ifset familyF2U
-@node Time8 Intrinsic
-@subsubsection Time8 Intrinsic
-@cindex Time8 intrinsic
-@cindex intrinsics, Time8
-
-@noindent
-@example
-Time8()
-@end example
-
-@noindent
-Time8: @code{INTEGER(KIND=2)} function.
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the current time encoded as a long integer
-(in the manner of the UNIX function @code{time(3)}).
-This value is suitable for passing to @code{CTIME},
-@code{GMTIME}, and @code{LTIME}.
-
-@cindex wraparound, timings
-@cindex limits, timings
-@emph{Warning:} this intrinsic does not increase the range
-of the timing values over that returned by @code{time(3)}.
-On a system with a 32-bit @code{time(3)},
-@code{TIME8} will return a 32-bit value,
-even though converted to an @samp{INTEGER(KIND=2)} value.
-That means overflows of the 32-bit value can still occur.
-Therefore, the values returned by this intrinsic
-might be, or become, negative,
-or numerically less than previous values,
-during a single run of the compiled program.
-
-No Fortran implementations other than GNU Fortran are
-known to support this intrinsic at the time of this
-writing.
-@xref{Time Intrinsic (UNIX)}, for information on a
-similar intrinsic that might be portable to more Fortran
-compilers, though to fewer GNU Fortran implementations.
-
-@end ifset
-@ifset familyF90
-@node Tiny Intrinsic
-@subsubsection Tiny Intrinsic
-@cindex Tiny intrinsic
-@cindex intrinsics, Tiny
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Tiny} to use this name for an
-external procedure.
-
-@node Transfer Intrinsic
-@subsubsection Transfer Intrinsic
-@cindex Transfer intrinsic
-@cindex intrinsics, Transfer
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Transfer} to use this name for an
-external procedure.
-
-@node Transpose Intrinsic
-@subsubsection Transpose Intrinsic
-@cindex Transpose intrinsic
-@cindex intrinsics, Transpose
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Transpose} to use this name for an
-external procedure.
-
-@node Trim Intrinsic
-@subsubsection Trim Intrinsic
-@cindex Trim intrinsic
-@cindex intrinsics, Trim
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Trim} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node TtyNam Intrinsic (subroutine)
-@subsubsection TtyNam Intrinsic (subroutine)
-@cindex TtyNam intrinsic
-@cindex intrinsics, TtyNam
-
-@noindent
-@example
-CALL TtyNam(@var{Unit}, @var{Name})
-@end example
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Name}: @code{CHARACTER}; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sets @var{Name} to the name of the terminal device open on logical unit
-@var{Unit} or to a blank string if @var{Unit} is not connected to a
-terminal.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{TtyNam Intrinsic (function)}.
-
-@node TtyNam Intrinsic (function)
-@subsubsection TtyNam Intrinsic (function)
-@cindex TtyNam intrinsic
-@cindex intrinsics, TtyNam
-
-@noindent
-@example
-TtyNam(@var{Unit})
-@end example
-
-@noindent
-TtyNam: @code{CHARACTER*(*)} function.
-
-@noindent
-@var{Unit}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Returns the name of the terminal device open on logical unit
-@var{Unit} or a blank string if @var{Unit} is not connected to a
-terminal.
-
-For information on other intrinsics with the same name:
-@xref{TtyNam Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node UBound Intrinsic
-@subsubsection UBound Intrinsic
-@cindex UBound intrinsic
-@cindex intrinsics, UBound
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL UBound} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2U
-@node UMask Intrinsic (subroutine)
-@subsubsection UMask Intrinsic (subroutine)
-@cindex UMask intrinsic
-@cindex intrinsics, UMask
-
-@noindent
-@example
-CALL UMask(@var{Mask}, @var{Old})
-@end example
-
-@noindent
-@var{Mask}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-@var{Old}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Sets the file creation mask to @var{Mask} and returns the old value in
-argument @var{Old} if it is supplied.
-See @code{umask(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine.
-
-For information on other intrinsics with the same name:
-@xref{UMask Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node UMask Intrinsic (function)
-@subsubsection UMask Intrinsic (function)
-@cindex UMask intrinsic
-@cindex intrinsics, UMask
-
-@noindent
-@example
-UMask(@var{Mask})
-@end example
-
-@noindent
-UMask: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{Mask}: @code{INTEGER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Sets the file creation mask to @var{Mask} and returns the old value.
-See @code{umask(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{UMask Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF2U
-@node Unlink Intrinsic (subroutine)
-@subsubsection Unlink Intrinsic (subroutine)
-@cindex Unlink intrinsic
-@cindex intrinsics, Unlink
-
-@noindent
-@example
-CALL Unlink(@var{File}, @var{Status})
-@end example
-
-@noindent
-@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-@var{Status}: @code{INTEGER(KIND=1)}; OPTIONAL; scalar; INTENT(OUT).
-
-@noindent
-Intrinsic groups: @code{unix}.
-
-@noindent
-Description:
-
-Unlink the file @var{File}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{File}---otherwise,
-trailing blanks in @var{File} are ignored.
-If the @var{Status} argument is supplied, it contains
-0 on success or a nonzero error code upon return.
-See @code{unlink(2)}.
-
-Some non-GNU implementations of Fortran provide this intrinsic as
-only a function, not as a subroutine, or do not support the
-(optional) @var{Status} argument.
-
-For information on other intrinsics with the same name:
-@xref{Unlink Intrinsic (function)}.
-
-@end ifset
-@ifset familyBADU77
-@node Unlink Intrinsic (function)
-@subsubsection Unlink Intrinsic (function)
-@cindex Unlink intrinsic
-@cindex intrinsics, Unlink
-
-@noindent
-@example
-Unlink(@var{File})
-@end example
-
-@noindent
-Unlink: @code{INTEGER(KIND=1)} function.
-
-@noindent
-@var{File}: @code{CHARACTER}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{badu77}.
-
-@noindent
-Description:
-
-Unlink the file @var{File}.
-A null character (@samp{CHAR(0)}) marks the end of
-the name in @var{File}---otherwise,
-trailing blanks in @var{File} are ignored.
-Returns 0 on success or a nonzero error code.
-See @code{unlink(2)}.
-
-Due to the side effects performed by this intrinsic, the function
-form is not recommended.
-
-For information on other intrinsics with the same name:
-@xref{Unlink Intrinsic (subroutine)}.
-
-@end ifset
-@ifset familyF90
-@node Unpack Intrinsic
-@subsubsection Unpack Intrinsic
-@cindex Unpack intrinsic
-@cindex intrinsics, Unpack
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Unpack} to use this name for an
-external procedure.
-
-@node Verify Intrinsic
-@subsubsection Verify Intrinsic
-@cindex Verify intrinsic
-@cindex intrinsics, Verify
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL Verify} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2C
-@node XOr Intrinsic
-@subsubsection XOr Intrinsic
-@cindex XOr intrinsic
-@cindex intrinsics, XOr
-
-@noindent
-@example
-XOr(@var{I}, @var{J})
-@end example
-
-@noindent
-XOr: @code{INTEGER} or @code{LOGICAL} function, the exact type being the result of cross-promoting the
-types of all the arguments.
-
-@noindent
-@var{I}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
-
-@noindent
-@var{J}: @code{INTEGER} or @code{LOGICAL}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Returns value resulting from boolean exclusive-OR of
-pair of bits in each of @var{I} and @var{J}.
-
-@node ZAbs Intrinsic
-@subsubsection ZAbs Intrinsic
-@cindex ZAbs intrinsic
-@cindex intrinsics, ZAbs
-
-@noindent
-@example
-ZAbs(@var{A})
-@end example
-
-@noindent
-ZAbs: @code{REAL(KIND=2)} function.
-
-@noindent
-@var{A}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Archaic form of @code{ABS()} that is specific
-to one type for @var{A}.
-@xref{Abs Intrinsic}.
-
-@node ZCos Intrinsic
-@subsubsection ZCos Intrinsic
-@cindex ZCos intrinsic
-@cindex intrinsics, ZCos
-
-@noindent
-@example
-ZCos(@var{X})
-@end example
-
-@noindent
-ZCos: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Archaic form of @code{COS()} that is specific
-to one type for @var{X}.
-@xref{Cos Intrinsic}.
-
-@node ZExp Intrinsic
-@subsubsection ZExp Intrinsic
-@cindex ZExp intrinsic
-@cindex intrinsics, ZExp
-
-@noindent
-@example
-ZExp(@var{X})
-@end example
-
-@noindent
-ZExp: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Archaic form of @code{EXP()} that is specific
-to one type for @var{X}.
-@xref{Exp Intrinsic}.
-
-@end ifset
-@ifset familyVXT
-@node ZExt Intrinsic
-@subsubsection ZExt Intrinsic
-@cindex ZExt intrinsic
-@cindex intrinsics, ZExt
-
-This intrinsic is not yet implemented.
-The name is, however, reserved as an intrinsic.
-Use @samp{EXTERNAL ZExt} to use this name for an
-external procedure.
-
-@end ifset
-@ifset familyF2C
-@node ZLog Intrinsic
-@subsubsection ZLog Intrinsic
-@cindex ZLog intrinsic
-@cindex intrinsics, ZLog
-
-@noindent
-@example
-ZLog(@var{X})
-@end example
-
-@noindent
-ZLog: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Archaic form of @code{LOG()} that is specific
-to one type for @var{X}.
-@xref{Log Intrinsic}.
-
-@node ZSin Intrinsic
-@subsubsection ZSin Intrinsic
-@cindex ZSin intrinsic
-@cindex intrinsics, ZSin
-
-@noindent
-@example
-ZSin(@var{X})
-@end example
-
-@noindent
-ZSin: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Archaic form of @code{SIN()} that is specific
-to one type for @var{X}.
-@xref{Sin Intrinsic}.
-
-@node ZSqRt Intrinsic
-@subsubsection ZSqRt Intrinsic
-@cindex ZSqRt intrinsic
-@cindex intrinsics, ZSqRt
-
-@noindent
-@example
-ZSqRt(@var{X})
-@end example
-
-@noindent
-ZSqRt: @code{COMPLEX(KIND=2)} function.
-
-@noindent
-@var{X}: @code{COMPLEX(KIND=2)}; scalar; INTENT(IN).
-
-@noindent
-Intrinsic groups: @code{f2c}.
-
-@noindent
-Description:
-
-Archaic form of @code{SQRT()} that is specific
-to one type for @var{X}.
-@xref{SqRt Intrinsic}.
-
-@end ifset
diff --git a/gcc/f/intrin.c b/gcc/f/intrin.c
deleted file mode 100644
index a379684..0000000
--- a/gcc/f/intrin.c
+++ /dev/null
@@ -1,2119 +0,0 @@
-/* intrin.c -- Recognize references to intrinsics
-   Copyright (C) 1995, 1996, 1997, 1998, 2002,
-   2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 "proj.h"
-#include "intrin.h"
-#include "expr.h"
-#include "info.h"
-#include "src.h"
-#include "symbol.h"
-#include "target.h"
-#include "top.h"
-
-struct _ffeintrin_name_
-  {
-    const char *const name_uc;
-    const char *const name_lc;
-    const char *const name_ic;
-    const ffeintrinGen generic;
-    const ffeintrinSpec specific;
-  };
-
-struct _ffeintrin_gen_
-  {
-    const char *const name;			/* Name as seen in program. */
-    const ffeintrinSpec specs[2];
-  };
-
-struct _ffeintrin_spec_
-  {
-    const char *const name;	/* Uppercase name as seen in source code,
-				   lowercase if no source name, "none" if no
-				   name at all (NONE case). */
-    const bool is_actualarg;	/* Ok to pass as actual arg if -pedantic. */
-    const ffeintrinFamily family;
-    const ffeintrinImp implementation;
-  };
-
-struct _ffeintrin_imp_
-  {
-    const char *const name;	/* Name of implementation. */
-    const ffecomGfrt gfrt_direct;/* library routine, direct-callable form. */
-    const ffecomGfrt gfrt_f2c;	/* library routine, f2c-callable form. */
-    const ffecomGfrt gfrt_gnu;	/* library routine, gnu-callable form. */
-    const char *const control;
-    const char y2kbad;
-  };
-
-static ffebad ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
-				ffebld args, ffeinfoBasictype *xbt,
-				ffeinfoKindtype *xkt,
-				ffetargetCharacterSize *xsz,
-				bool *check_intrin,
-				ffelexToken t,
-				bool commit);
-static bool ffeintrin_check_any_ (ffebld arglist);
-static int ffeintrin_cmp_name_ (const void *name, const void *intrinsic);
-
-static const struct _ffeintrin_name_ ffeintrin_names_[]
-=
-{				/* Alpha order. */
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC) \
-  { UPPER, LOWER, MIXED, FFEINTRIN_ ## GEN, FFEINTRIN_ ## SPEC },
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-static const struct _ffeintrin_gen_ ffeintrin_gens_[]
-=
-{
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2) \
-  { NAME, { SPEC1, SPEC2, }, },
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-static const struct _ffeintrin_imp_ ffeintrin_imps_[]
-=
-{
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
-      { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
-	FFECOM_gfrt ## GFRTGNU, CONTROL, FALSE },
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
-      { NAME, FFECOM_gfrt ## GFRTDIRECT, FFECOM_gfrt ## GFRTF2C, \
-	FFECOM_gfrt ## GFRTGNU, CONTROL, Y2KBAD },
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-static const struct _ffeintrin_spec_ ffeintrin_specs_[]
-=
-{
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) \
-  { NAME, CALLABLE, FAMILY, IMP, },
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-};
-
-
-static ffebad
-ffeintrin_check_ (ffeintrinImp imp, ffebldOp op,
-		  ffebld args, ffeinfoBasictype *xbt,
-		  ffeinfoKindtype *xkt,
-		  ffetargetCharacterSize *xsz,
-		  bool *check_intrin,
-		  ffelexToken t,
-		  bool commit)
-{
-  const char *c = ffeintrin_imps_[imp].control;
-  bool subr = (c[0] == '-');
-  const char *argc;
-  ffebld arg;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
-  ffeinfoKindtype firstarg_kt;
-  bool need_col;
-  ffeinfoBasictype col_bt = FFEINFO_basictypeNONE;
-  ffeinfoKindtype col_kt = FFEINFO_kindtypeNONE;
-  int colon = (c[2] == ':') ? 2 : 3;
-  int argno;
-
-  /* Check procedure type (function vs. subroutine) against
-     invocation.  */
-
-  if (op == FFEBLD_opSUBRREF)
-    {
-      if (!subr)
-	return FFEBAD_INTRINSIC_IS_FUNC;
-    }
-  else if (op == FFEBLD_opFUNCREF)
-    {
-      if (subr)
-	return FFEBAD_INTRINSIC_IS_SUBR;
-    }
-  else
-    return FFEBAD_INTRINSIC_REF;
-
-  /* Check the arglist for validity.  */
-
-  if ((args != NULL)
-      && (ffebld_head (args) != NULL))
-    firstarg_kt = ffeinfo_kindtype (ffebld_info (ffebld_head (args)));
-  else
-    firstarg_kt = FFEINFO_kindtype;
-
-  for (argc = &c[colon + 3],
-	 arg = args;
-       *argc != '\0';
-       )
-    {
-      char optional = '\0';
-      char required = '\0';
-      char extra = '\0';
-      char basic;
-      char kind;
-      int length;
-      int elements;
-      bool lastarg_complex = FALSE;
-
-      /* We don't do anything with keywords yet.  */
-      do
-	{
-	} while (*(++argc) != '=');
-
-      ++argc;
-      if ((*argc == '?')
-	  || (*argc == '!')
-	  || (*argc == '*'))
-	optional = *(argc++);
-      if ((*argc == '+')
-	  || (*argc == 'n')
-	  || (*argc == 'p'))
-	required = *(argc++);
-      basic = *(argc++);
-      kind = *(argc++);
-      if (*argc == '[')
-	{
-	  length = *++argc - '0';
-	  if (*++argc != ']')
-	    length = 10 * length + (*(argc++) - '0');
-	  ++argc;
-	}
-      else
-	length = -1;
-      if (*argc == '(')
-	{
-	  elements = *++argc - '0';
-	  if (*++argc != ')')
-	    elements = 10 * elements + (*(argc++) - '0');
-	  ++argc;
-	}
-      else if (*argc == '&')
-	{
-	  elements = -1;
-	  ++argc;
-	}
-      else
-	elements = 0;
-      if ((*argc == '&')
-	  || (*argc == 'i')
-	  || (*argc == 'w')
-	  || (*argc == 'x'))
-	extra = *(argc++);
-      if (*argc == ',')
-	++argc;
-
-      /* Break out of this loop only when current arg spec completely
-	 processed.  */
-
-      do
-	{
-	  bool okay;
-	  ffebld a;
-	  ffeinfo i;
-	  bool anynum;
-	  ffeinfoBasictype abt = FFEINFO_basictypeNONE;
-	  ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
-
-	  if ((arg == NULL)
-	      || (ffebld_head (arg) == NULL))
-	    {
-	      if (required != '\0')
-		return FFEBAD_INTRINSIC_TOOFEW;
-	      if (optional == '\0')
-		return FFEBAD_INTRINSIC_TOOFEW;
-	      if (arg != NULL)
-		arg = ffebld_trail (arg);
-	      break;	/* Try next argspec. */
-	    }
-
-	  a = ffebld_head (arg);
-	  i = ffebld_info (a);
-	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
-	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
-
-	  /* See how well the arg matches up to the spec.  */
-
-	  switch (basic)
-	    {
-	    case 'A':
-	      okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
-		&& ((length == -1)
-		    || (ffeinfo_size (i) == (ffetargetCharacterSize) length));
-	      break;
-
-	    case 'C':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
-	      abt = FFEINFO_basictypeCOMPLEX;
-	      break;
-
-	    case 'I':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
-	      abt = FFEINFO_basictypeINTEGER;
-	      break;
-
-	    case 'L':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
-	      abt = FFEINFO_basictypeLOGICAL;
-	      break;
-
-	    case 'R':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      abt = FFEINFO_basictypeREAL;
-	      break;
-
-	    case 'B':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
-	      break;
-
-	    case 'F':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      break;
-
-	    case 'N':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      break;
-
-	    case 'S':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      break;
-
-	    case 'g':
-	      okay = ((ffebld_op (a) == FFEBLD_opLABTER)
-		      || (ffebld_op (a) == FFEBLD_opLABTOK));
-	      elements = -1;
-	      extra = '-';
-	      break;
-
-	    case 's':
-	      okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
-			 && (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
-			 && (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
-			|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-			    && (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
-			    && (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
-			|| (ffeinfo_kind (i) == FFEINFO_kindNONE))
-		       && ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
-			   || (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
-		      || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-			  && (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
-	      elements = -1;
-	      extra = '-';
-	      break;
-
-	    case '-':
-	    default:
-	      okay = TRUE;
-	      break;
-	    }
-
-	  switch (kind)
-	    {
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      akt = (kind - '0');
-	      if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		  || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
-		{
-		  switch (akt)
-		    {	/* Translate to internal kinds for now! */
-		    default:
-		      break;
-
-		    case 2:
-		      akt = 4;
-		      break;
-
-		    case 3:
-		      akt = 2;
-		      break;
-
-		    case 4:
-		      akt = 5;
-		      break;
-
-		    case 6:
-		      akt = 3;
-		      break;
-
-		    case 7:
-		      akt = ffecom_pointer_kind ();
-		      break;
-		    }
-		}
-	      okay &= anynum || (ffeinfo_kindtype (i) == akt);
-	      break;
-
-	    case 'A':
-	      okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
-	      akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
-		: firstarg_kt;
-	      break;
-
-	    case 'N':
-	      /* Accept integers and logicals not wider than the default integer/logical.  */
-	      if (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		{
-		  okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER1
-					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER2
-					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGER3);
-		  akt = FFEINFO_kindtypeINTEGER1;	/* The default.  */
-		}
-	      else if (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL)
-		{
-		  okay &= anynum || (ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL1
-					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL2
-					|| ffeinfo_kindtype (i) == FFEINFO_kindtypeLOGICAL3);
-		  akt = FFEINFO_kindtypeLOGICAL1;	/* The default.  */
-		}
-	      break;
-
-	    case '*':
-	    default:
-	      break;
-	    }
-
-	  switch (elements)
-	    {
-	      ffebld b;
-
-	    case -1:
-	      break;
-
-	    case 0:
-	      if (ffeinfo_rank (i) != 0)
-		okay = FALSE;
-	      break;
-
-	    default:
-	      if ((ffeinfo_rank (i) != 1)
-		  || (ffebld_op (a) != FFEBLD_opSYMTER)
-		  || ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
-		  || (ffebld_op (b) != FFEBLD_opCONTER)
-		  || (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
-		  || (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
-		  || (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
-		okay = FALSE;
-	      break;
-	    }
-
-	  switch (extra)
-	    {
-	    case '&':
-	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
-		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
-		      && (ffebld_op (a) != FFEBLD_opSUBSTR)
-		      && (ffebld_op (a) != FFEBLD_opARRAYREF)))
-		okay = FALSE;
-	      break;
-
-	    case 'w':
-	    case 'x':
-	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
-		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
-		      && (ffebld_op (a) != FFEBLD_opARRAYREF)
-		      && (ffebld_op (a) != FFEBLD_opSUBSTR)))
-		okay = FALSE;
-	      break;
-
-	    case '-':
-	    case 'i':
-	      break;
-
-	    default:
-	      if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
-		okay = FALSE;
-	      break;
-	    }
-
-	  if ((optional == '!')
-	      && lastarg_complex)
-	    okay = FALSE;
-
-	  if (!okay)
-	    {
-	      /* If it wasn't optional, it's an error,
-		 else maybe it could match a later argspec.  */
-	      if (optional == '\0')
-		return FFEBAD_INTRINSIC_REF;
-	      break;	/* Try next argspec. */
-	    }
-
-	  lastarg_complex
-	    = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
-
-	  if (anynum)
-	    {
-	      /* If we know dummy arg type, convert to that now.  */
-
-	      if ((abt != FFEINFO_basictypeNONE)
-		  && (akt != FFEINFO_kindtypeNONE)
-		  && commit)
-		{
-		  /* We have a known type, convert hollerith/typeless
-		     to it.  */
-
-		  a = ffeexpr_convert (a, t, NULL,
-				       abt, akt, 0,
-				       FFETARGET_charactersizeNONE,
-				       FFEEXPR_contextLET);
-		  ffebld_set_head (arg, a);
-		}
-	    }
-
-	  arg = ffebld_trail (arg);	/* Arg accepted, now move on. */
-
-	  if (optional == '*')
-	    continue;	/* Go ahead and try another arg. */
-	  if (required == '\0')
-	    break;
-	  if ((required == 'n')
-	      || (required == '+'))
-	    {
-	      optional = '*';
-	      required = '\0';
-	    }
-	  else if (required == 'p')
-	    required = 'n';
-	} while (TRUE);
-    }
-
-  if (arg != NULL)
-    return FFEBAD_INTRINSIC_TOOMANY;
-
-  /* Set up the initial type for the return value of the function.  */
-
-  need_col = FALSE;
-  switch (c[0])
-    {
-    case 'A':
-      bt = FFEINFO_basictypeCHARACTER;
-      sz = (c[2] == '*') ? FFETARGET_charactersizeNONE : 1;
-      break;
-
-    case 'C':
-      bt = FFEINFO_basictypeCOMPLEX;
-      break;
-
-    case 'I':
-      bt = FFEINFO_basictypeINTEGER;
-      break;
-
-    case 'L':
-      bt = FFEINFO_basictypeLOGICAL;
-      break;
-
-    case 'R':
-      bt = FFEINFO_basictypeREAL;
-      break;
-
-    case 'B':
-    case 'F':
-    case 'N':
-    case 'S':
-      need_col = TRUE;
-      /* Fall through.  */
-    case '-':
-    default:
-      bt = FFEINFO_basictypeNONE;
-      break;
-    }
-
-  switch (c[1])
-    {
-    case '1': case '2': case '3': case '4': case '5':
-    case '6': case '7': case '8': case '9':
-      kt = (c[1] - '0');
-      if ((bt == FFEINFO_basictypeINTEGER)
-	  || (bt == FFEINFO_basictypeLOGICAL))
-	{
-	  switch (kt)
-	    {	/* Translate to internal kinds for now! */
-	    default:
-	      break;
-
-	    case 2:
-	      kt = 4;
-	      break;
-
-	    case 3:
-	      kt = 2;
-	      break;
-
-	    case 4:
-	      kt = 5;
-	      break;
-
-	    case 6:
-	      kt = 3;
-	      break;
-
-	    case 7:
-	      kt = ffecom_pointer_kind ();
-	      break;
-	    }
-	}
-      break;
-
-    case 'C':
-      if (ffe_is_90 ())
-	need_col = TRUE;
-      kt = 1;
-      break;
-
-    case '=':
-      need_col = TRUE;
-      /* Fall through.  */
-    case '-':
-    default:
-      kt = FFEINFO_kindtypeNONE;
-      break;
-    }
-
-  /* Determine collective type of COL, if there is one.  */
-
-  if (need_col || c[colon + 1] != '-')
-    {
-      bool okay = TRUE;
-      bool have_anynum = FALSE;
-      int  arg_count=0;
-
-      for (arg = args, arg_count=0;
-	   arg != NULL;
-	   arg = ffebld_trail (arg), arg_count++ )
-	{
-	  ffebld a = ffebld_head (arg);
-	  ffeinfo i;
-	  bool anynum;
-
-	  if (a == NULL)
-	    continue;
-	  i = ffebld_info (a);
-
-	  if ( c[colon+1] != '*' && (c[colon+1]-'0') != arg_count )
-	    continue;
-
-	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
-	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
-	  if (anynum)
-	    {
-	      have_anynum = TRUE;
-	      continue;
-	    }
-
-	  if ((col_bt == FFEINFO_basictypeNONE)
-	      && (col_kt == FFEINFO_kindtypeNONE))
-	    {
-	      col_bt = ffeinfo_basictype (i);
-	      col_kt = ffeinfo_kindtype (i);
-	    }
-	  else
-	    {
-	      ffeexpr_type_combine (&col_bt, &col_kt,
-				    col_bt, col_kt,
-				    ffeinfo_basictype (i),
-				    ffeinfo_kindtype (i),
-				    NULL);
-	      if ((col_bt == FFEINFO_basictypeNONE)
-		  || (col_kt == FFEINFO_kindtypeNONE))
-		return FFEBAD_INTRINSIC_REF;
-	    }
-	}
-
-      if (have_anynum
-	  && ((col_bt == FFEINFO_basictypeNONE)
-	      || (col_kt == FFEINFO_kindtypeNONE)))
-	{
-	  /* No type, but have hollerith/typeless.  Use type of return
-	     value to determine type of COL.  */
-
-	  switch (c[0])
-	    {
-	    case 'A':
-	      return FFEBAD_INTRINSIC_REF;
-
-	    case 'B':
-	    case 'I':
-	    case 'L':
-	      if ((col_bt != FFEINFO_basictypeNONE)
-		  && (col_bt != FFEINFO_basictypeINTEGER))
-		return FFEBAD_INTRINSIC_REF;
-	      /* Fall through.  */
-	    case 'N':
-	    case 'S':
-	    case '-':
-	    default:
-	      col_bt = FFEINFO_basictypeINTEGER;
-	      col_kt = FFEINFO_kindtypeINTEGER1;
-	      break;
-
-	    case 'C':
-	      if ((col_bt != FFEINFO_basictypeNONE)
-		  && (col_bt != FFEINFO_basictypeCOMPLEX))
-		return FFEBAD_INTRINSIC_REF;
-	      col_bt = FFEINFO_basictypeCOMPLEX;
-	      col_kt = FFEINFO_kindtypeREAL1;
-	      break;
-
-	    case 'R':
-	      if ((col_bt != FFEINFO_basictypeNONE)
-		  && (col_bt != FFEINFO_basictypeREAL))
-		return FFEBAD_INTRINSIC_REF;
-	      /* Fall through.  */
-	    case 'F':
-	      col_bt = FFEINFO_basictypeREAL;
-	      col_kt = FFEINFO_kindtypeREAL1;
-	      break;
-	    }
-	}
-
-      switch (c[0])
-	{
-	case 'B':
-	  okay = (col_bt == FFEINFO_basictypeINTEGER)
-	    || (col_bt == FFEINFO_basictypeLOGICAL);
-	  if (need_col)
-	    bt = col_bt;
-	  break;
-
-	case 'F':
-	  okay = (col_bt == FFEINFO_basictypeCOMPLEX)
-	    || (col_bt == FFEINFO_basictypeREAL);
-	  if (need_col)
-	    bt = col_bt;
-	  break;
-
-	case 'N':
-	  okay = (col_bt == FFEINFO_basictypeCOMPLEX)
-	    || (col_bt == FFEINFO_basictypeINTEGER)
-	    || (col_bt == FFEINFO_basictypeREAL);
-	  if (need_col)
-	    bt = col_bt;
-	  break;
-
-	case 'S':
-	  okay = (col_bt == FFEINFO_basictypeINTEGER)
-	    || (col_bt == FFEINFO_basictypeREAL)
-	    || (col_bt == FFEINFO_basictypeCOMPLEX);
-	  if (need_col)
-	    bt = ((col_bt != FFEINFO_basictypeCOMPLEX) ? col_bt
-		  : FFEINFO_basictypeREAL);
-	  break;
-	}
-
-      switch (c[1])
-	{
-	case '=':
-	  if (need_col)
-	    kt = col_kt;
-	  break;
-
-	case 'C':
-	  if (col_bt == FFEINFO_basictypeCOMPLEX)
-	    {
-	      if (col_kt != FFEINFO_kindtypeREALDEFAULT)
-		*check_intrin = TRUE;
-	      if (need_col)
-		kt = col_kt;
-	    }
-	  break;
-	}
-
-      if (!okay)
-	return FFEBAD_INTRINSIC_REF;
-    }
-
-  /* Now, convert args in the arglist to the final type of the COL.  */
-
-  for (argno = 0, argc = &c[colon + 3],
-	 arg = args;
-       *argc != '\0';
-       ++argno)
-    {
-      char optional = '\0';
-      char required = '\0';
-      char extra = '\0';
-      char basic;
-      char kind;
-      int length;
-      int elements;
-      bool lastarg_complex = FALSE;
-
-      /* We don't do anything with keywords yet.  */
-      do
-	{
-	} while (*(++argc) != '=');
-
-      ++argc;
-      if ((*argc == '?')
-	  || (*argc == '!')
-	  || (*argc == '*'))
-	optional = *(argc++);
-      if ((*argc == '+')
-	  || (*argc == 'n')
-	  || (*argc == 'p'))
-	required = *(argc++);
-      basic = *(argc++);
-      kind = *(argc++);
-      if (*argc == '[')
-	{
-	  length = *++argc - '0';
-	  if (*++argc != ']')
-	    length = 10 * length + (*(argc++) - '0');
-	  ++argc;
-	}
-      else
-	length = -1;
-      if (*argc == '(')
-	{
-	  elements = *++argc - '0';
-	  if (*++argc != ')')
-	    elements = 10 * elements + (*(argc++) - '0');
-	  ++argc;
-	}
-      else if (*argc == '&')
-	{
-	  elements = -1;
-	  ++argc;
-	}
-      else
-	elements = 0;
-      if ((*argc == '&')
-	  || (*argc == 'i')
-	  || (*argc == 'w')
-	  || (*argc == 'x'))
-	extra = *(argc++);
-      if (*argc == ',')
-	++argc;
-
-      /* Break out of this loop only when current arg spec completely
-	 processed.  */
-
-      do
-	{
-	  bool okay;
-	  ffebld a;
-	  ffeinfo i;
-	  bool anynum;
-	  ffeinfoBasictype abt = FFEINFO_basictypeNONE;
-	  ffeinfoKindtype akt = FFEINFO_kindtypeNONE;
-
-	  if ((arg == NULL)
-	      || (ffebld_head (arg) == NULL))
-	    {
-	      if (arg != NULL)
-		arg = ffebld_trail (arg);
-	      break;	/* Try next argspec. */
-	    }
-
-	  a = ffebld_head (arg);
-	  i = ffebld_info (a);
-	  anynum = (ffeinfo_basictype (i) == FFEINFO_basictypeHOLLERITH)
-	    || (ffeinfo_basictype (i) == FFEINFO_basictypeTYPELESS);
-
-	  /* Determine what the default type for anynum would be.  */
-
-	  if (anynum)
-	    {
-	      switch (c[colon + 1])
-		{
-		case '-':
-		  break;
-		case '0': case '1': case '2': case '3': case '4':
-		case '5': case '6': case '7': case '8': case '9':
-		  if (argno != (c[colon + 1] - '0'))
-		    break;
-		case '*':
-		  abt = col_bt;
-		  akt = col_kt;
-		  break;
-		}
-	    }
-
-	  /* Again, match arg up to the spec.  We go through all of
-	     this again to properly follow the contour of optional
-	     arguments.  Probably this level of flexibility is not
-	     needed, perhaps it's even downright naughty.  */
-
-	  switch (basic)
-	    {
-	    case 'A':
-	      okay = (ffeinfo_basictype (i) == FFEINFO_basictypeCHARACTER)
-		&& ((length == -1)
-		    || (ffeinfo_size (i) == (ffetargetCharacterSize) length));
-	      break;
-
-	    case 'C':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
-	      abt = FFEINFO_basictypeCOMPLEX;
-	      break;
-
-	    case 'I':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER);
-	      abt = FFEINFO_basictypeINTEGER;
-	      break;
-
-	    case 'L':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
-	      abt = FFEINFO_basictypeLOGICAL;
-	      break;
-
-	    case 'R':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      abt = FFEINFO_basictypeREAL;
-	      break;
-
-	    case 'B':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL);
-	      break;
-
-	    case 'F':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      break;
-
-	    case 'N':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      break;
-
-	    case 'S':
-	      okay = anynum
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		|| (ffeinfo_basictype (i) == FFEINFO_basictypeREAL);
-	      break;
-
-	    case 'g':
-	      okay = ((ffebld_op (a) == FFEBLD_opLABTER)
-		      || (ffebld_op (a) == FFEBLD_opLABTOK));
-	      elements = -1;
-	      extra = '-';
-	      break;
-
-	    case 's':
-	      okay = (((((ffeinfo_basictype (i) == FFEINFO_basictypeNONE)
-			 && (ffeinfo_kindtype (i) == FFEINFO_kindtypeNONE)
-			 && (ffeinfo_kind (i) == FFEINFO_kindSUBROUTINE))
-			|| ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-			    && (ffeinfo_kindtype (i) == FFEINFO_kindtypeINTEGERDEFAULT)
-			    && (ffeinfo_kind (i) == FFEINFO_kindFUNCTION))
-			|| (ffeinfo_kind (i) == FFEINFO_kindNONE))
-		       && ((ffeinfo_where (i) == FFEINFO_whereDUMMY)
-			   || (ffeinfo_where (i) == FFEINFO_whereGLOBAL)))
-		      || ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-			  && (ffeinfo_kind (i) == FFEINFO_kindENTITY)));
-	      elements = -1;
-	      extra = '-';
-	      break;
-
-	    case '-':
-	    default:
-	      okay = TRUE;
-	      break;
-	    }
-
-	  switch (kind)
-	    {
-	    case '1': case '2': case '3': case '4': case '5':
-	    case '6': case '7': case '8': case '9':
-	      akt = (kind - '0');
-	      if ((ffeinfo_basictype (i) == FFEINFO_basictypeINTEGER)
-		  || (ffeinfo_basictype (i) == FFEINFO_basictypeLOGICAL))
-		{
-		  switch (akt)
-		    {	/* Translate to internal kinds for now! */
-		    default:
-		      break;
-
-		    case 2:
-		      akt = 4;
-		      break;
-
-		    case 3:
-		      akt = 2;
-		      break;
-
-		    case 4:
-		      akt = 5;
-		      break;
-
-		    case 6:
-		      akt = 3;
-		      break;
-
-		    case 7:
-		      akt = ffecom_pointer_kind ();
-		      break;
-		    }
-		}
-	      okay &= anynum || (ffeinfo_kindtype (i) == akt);
-	      break;
-
-	    case 'A':
-	      okay &= anynum || (ffeinfo_kindtype (i) == firstarg_kt);
-	      akt = (firstarg_kt == FFEINFO_kindtype) ? FFEINFO_kindtypeNONE
-		: firstarg_kt;
-	      break;
-
-	    case '*':
-	    default:
-	      break;
-	    }
-
-	  switch (elements)
-	    {
-	      ffebld b;
-
-	    case -1:
-	      break;
-
-	    case 0:
-	      if (ffeinfo_rank (i) != 0)
-		okay = FALSE;
-	      break;
-
-	    default:
-	      if ((ffeinfo_rank (i) != 1)
-		  || (ffebld_op (a) != FFEBLD_opSYMTER)
-		  || ((b = ffesymbol_arraysize (ffebld_symter (a))) == NULL)
-		  || (ffebld_op (b) != FFEBLD_opCONTER)
-		  || (ffeinfo_basictype (ffebld_info (b)) != FFEINFO_basictypeINTEGER)
-		  || (ffeinfo_kindtype (ffebld_info (b)) != FFEINFO_kindtypeINTEGERDEFAULT)
-		  || (ffebld_constant_integer1 (ffebld_conter (b)) != elements))
-		okay = FALSE;
-	      break;
-	    }
-
-	  switch (extra)
-	    {
-	    case '&':
-	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
-		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
-		      && (ffebld_op (a) != FFEBLD_opSUBSTR)
-		      && (ffebld_op (a) != FFEBLD_opARRAYREF)))
-		okay = FALSE;
-	      break;
-
-	    case 'w':
-	    case 'x':
-	      if ((ffeinfo_kind (i) != FFEINFO_kindENTITY)
-		  || ((ffebld_op (a) != FFEBLD_opSYMTER)
-		      && (ffebld_op (a) != FFEBLD_opARRAYREF)
-		      && (ffebld_op (a) != FFEBLD_opSUBSTR)))
-		okay = FALSE;
-	      break;
-
-	    case '-':
-	    case 'i':
-	      break;
-
-	    default:
-	      if (ffeinfo_kind (i) != FFEINFO_kindENTITY)
-		okay = FALSE;
-	      break;
-	    }
-
-	  if ((optional == '!')
-	      && lastarg_complex)
-	    okay = FALSE;
-
-	  if (!okay)
-	    {
-	      /* If it wasn't optional, it's an error,
-		 else maybe it could match a later argspec.  */
-	      if (optional == '\0')
-		return FFEBAD_INTRINSIC_REF;
-	      break;	/* Try next argspec. */
-	    }
-
-	  lastarg_complex
-	    = (ffeinfo_basictype (i) == FFEINFO_basictypeCOMPLEX);
-
-	  if (anynum && commit)
-	    {
-	      /* If we know dummy arg type, convert to that now.  */
-
-	      if (abt == FFEINFO_basictypeNONE)
-		abt = FFEINFO_basictypeINTEGER;
-	      if (akt == FFEINFO_kindtypeNONE)
-		akt = FFEINFO_kindtypeINTEGER1;
-
-	      /* We have a known type, convert hollerith/typeless to it.  */
-
-	      a = ffeexpr_convert (a, t, NULL,
-				   abt, akt, 0,
-				   FFETARGET_charactersizeNONE,
-				   FFEEXPR_contextLET);
-	      ffebld_set_head (arg, a);
-	    }
-	  else if ((c[colon + 1] == '*') && commit)
-	    {
-	      /* This is where we promote types to the consensus
-		 type for the COL.  Maybe this is where -fpedantic
-		 should issue a warning as well.  */
-
-	      a = ffeexpr_convert (a, t, NULL,
-				   col_bt, col_kt, 0,
-				   ffeinfo_size (i),
-				   FFEEXPR_contextLET);
-	      ffebld_set_head (arg, a);
-	    }
-
-	  arg = ffebld_trail (arg);	/* Arg accepted, now move on. */
-
-	  if (optional == '*')
-	    continue;	/* Go ahead and try another arg. */
-	  if (required == '\0')
-	    break;
-	  if ((required == 'n')
-	      || (required == '+'))
-	    {
-	      optional = '*';
-	      required = '\0';
-	    }
-	  else if (required == 'p')
-	    required = 'n';
-	} while (TRUE);
-    }
-
-  *xbt = bt;
-  *xkt = kt;
-  *xsz = sz;
-  return FFEBAD;
-}
-
-static bool
-ffeintrin_check_any_ (ffebld arglist)
-{
-  ffebld item;
-
-  for (; arglist != NULL; arglist = ffebld_trail (arglist))
-    {
-      item = ffebld_head (arglist);
-      if ((item != NULL)
-	  && (ffebld_op (item) == FFEBLD_opANY))
-	return TRUE;
-    }
-
-  return FALSE;
-}
-
-/* Compare a forced-to-uppercase name with a known-upper-case name.  */
-
-static int
-upcasecmp_ (const char *name, const char *ucname)
-{
-  for ( ; *name != 0 && *ucname != 0; name++, ucname++)
-    {
-      int i = TOUPPER(*name) - *ucname;
-
-      if (i != 0)
-        return i;
-    }
-
-  return *name - *ucname;
-}
-
-/* Compare name to intrinsic's name.
-   The intrinsics table is sorted on the upper case entries; so first
-   compare irrespective of case on the `uc' entry.  If it matches,
-   compare according to the setting of intrinsics case comparison mode.  */
-
-static int
-ffeintrin_cmp_name_ (const void *name, const void *intrinsic)
-{
-  const char *const uc = ((const struct _ffeintrin_name_ *) intrinsic)->name_uc;
-  const char *const lc = ((const struct _ffeintrin_name_ *) intrinsic)->name_lc;
-  const char *const ic = ((const struct _ffeintrin_name_ *) intrinsic)->name_ic;
-  int i;
-
-  if ((i = upcasecmp_ (name, uc)) == 0)
-    {
-      switch (ffe_case_intrin ())
-	{
-	case FFE_caseLOWER:
-	  return strcmp(name, lc);
-	case FFE_caseINITCAP:
-	  return strcmp(name, ic);
-	default:
-	  return 0;
-	}
-    }
-
-  return i;
-}
-
-/* Return basic type of intrinsic implementation, based on its
-   run-time implementation *only*.  (This is used only when
-   the type of an intrinsic name is needed without having a
-   list of arguments, i.e. an interface signature, such as when
-   passing the intrinsic itself, or really the run-time-library
-   function, as an argument.)
-
-   If there's no eligible intrinsic implementation, there must be
-   a bug somewhere else; no such reference should have been permitted
-   to go this far.  (Well, this might be wrong.)  */
-
-ffeinfoBasictype
-ffeintrin_basictype (ffeintrinSpec spec)
-{
-  ffeintrinImp imp;
-  ffecomGfrt gfrt;
-
-  assert (spec < FFEINTRIN_spec);
-  imp = ffeintrin_specs_[spec].implementation;
-  assert (imp < FFEINTRIN_imp);
-
-  if (ffe_is_f2c ())
-    gfrt = ffeintrin_imps_[imp].gfrt_f2c;
-  else
-    gfrt = ffeintrin_imps_[imp].gfrt_gnu;
-
-  assert (gfrt != FFECOM_gfrt);
-
-  return ffecom_gfrt_basictype (gfrt);
-}
-
-/* Return family to which specific intrinsic belongs.  */
-
-ffeintrinFamily
-ffeintrin_family (ffeintrinSpec spec)
-{
-  if (spec >= FFEINTRIN_spec)
-    return FALSE;
-  return ffeintrin_specs_[spec].family;
-}
-
-/* Check and fill in info on func/subr ref node.
-
-   ffebld expr;			// FUNCREF or SUBRREF with no info (caller
-				// gets it from the modified info structure).
-   ffeinfo info;		// Already filled in, will be overwritten.
-   ffelexToken token;		// Used for error message.
-   ffeintrin_fulfill_generic (&expr, &info, token);
-
-   Based on the generic id, figure out which specific procedure is meant and
-   pick that one.  Else return an error, a la _specific.  */
-
-void
-ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t)
-{
-  ffebld symter;
-  ffebldOp op;
-  ffeintrinGen gen;
-  ffeintrinSpec spec = FFEINTRIN_specNONE;
-  ffeinfoBasictype bt = FFEINFO_basictypeNONE;
-  ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
-  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
-  ffeintrinImp imp;
-  ffeintrinSpec tspec;
-  ffeintrinImp nimp = FFEINTRIN_impNONE;
-  ffebad error;
-  bool any = FALSE;
-  bool highly_specific = FALSE;
-  int i;
-
-  op = ffebld_op (*expr);
-  assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
-  assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);
-
-  gen = ffebld_symter_generic (ffebld_left (*expr));
-  assert (gen != FFEINTRIN_genNONE);
-
-  imp = FFEINTRIN_impNONE;
-  error = FFEBAD;
-
-  any = ffeintrin_check_any_ (ffebld_right (*expr));
-
-  for (i = 0;
-       (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
-	 && ((tspec = ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE)
-	 && !any;
-       ++i)
-    {
-      ffeintrinImp timp = ffeintrin_specs_[tspec].implementation;
-      ffeinfoBasictype tbt;
-      ffeinfoKindtype tkt;
-      ffetargetCharacterSize tsz;
-      ffeIntrinsicState state
-      = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
-      ffebad terror;
-
-      if (state == FFE_intrinsicstateDELETED)
-	continue;
-
-      if (timp != FFEINTRIN_impNONE)
-	{
-	  if (!(ffeintrin_imps_[timp].control[0] == '-')
-	      != !(ffebld_op (*expr) == FFEBLD_opSUBRREF))
-	    continue;		/* Form of reference must match form of specific. */
-	}
-
-      if (state == FFE_intrinsicstateDISABLED)
-	terror = FFEBAD_INTRINSIC_DISABLED;
-      else if (timp == FFEINTRIN_impNONE)
-	terror = FFEBAD_INTRINSIC_UNIMPL;
-      else
-	{
-	  terror = ffeintrin_check_ (timp, ffebld_op (*expr),
-				     ffebld_right (*expr),
-				     &tbt, &tkt, &tsz, NULL, t, FALSE);
-	  if (terror == FFEBAD)
-	    {
-	      if (imp != FFEINTRIN_impNONE)
-		{
-		  ffebad_start (FFEBAD_INTRINSIC_AMBIG);
-		  ffebad_here (0, ffelex_token_where_line (t),
-			       ffelex_token_where_column (t));
-		  ffebad_string (ffeintrin_gens_[gen].name);
-		  ffebad_string (ffeintrin_specs_[spec].name);
-		  ffebad_string (ffeintrin_specs_[tspec].name);
-		  ffebad_finish ();
-		}
-	      else
-		{
-		  if (ffebld_symter_specific (ffebld_left (*expr))
-		      == tspec)
-		    highly_specific = TRUE;
-		  imp = timp;
-		  spec = tspec;
-		  bt = tbt;
-		  kt = tkt;
-		  sz = tkt;
-		  error = terror;
-		}
-	    }
-	  else if (terror != FFEBAD)
-	    {			/* This error has precedence over others. */
-	      if ((error == FFEBAD_INTRINSIC_DISABLED)
-		  || (error == FFEBAD_INTRINSIC_UNIMPL))
-		error = FFEBAD;
-	    }
-	}
-
-      if (error == FFEBAD)
-	error = terror;
-    }
-
-  if (any || (imp == FFEINTRIN_impNONE))
-    {
-      if (!any)
-	{
-	  if (error == FFEBAD)
-	    error = FFEBAD_INTRINSIC_REF;
-	  ffebad_start (error);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (ffeintrin_gens_[gen].name);
-	  ffebad_finish ();
-	}
-
-      *expr = ffebld_new_any ();
-      *info = ffeinfo_new_any ();
-    }
-  else
-    {
-      if (!highly_specific && (nimp != FFEINTRIN_impNONE))
-	{
-	  fprintf (stderr, "lineno=%ld, gen=%s, imp=%s, timp=%s\n",
-		   (long) input_line,
-		   ffeintrin_gens_[gen].name,
-		   ffeintrin_imps_[imp].name,
-		   ffeintrin_imps_[nimp].name);
-	  assert ("Ambiguous generic reference" == NULL);
-	  abort ();
-	}
-      error = ffeintrin_check_ (imp, ffebld_op (*expr),
-				ffebld_right (*expr),
-				&bt, &kt, &sz, NULL, t, TRUE);
-      assert (error == FFEBAD);
-      *info = ffeinfo_new (bt,
-			   kt,
-			   0,
-			   FFEINFO_kindENTITY,
-			   FFEINFO_whereFLEETING,
-			   sz);
-      symter = ffebld_left (*expr);
-      ffebld_symter_set_specific (symter, spec);
-      ffebld_symter_set_implementation (symter, imp);
-      ffebld_set_info (symter,
-		       ffeinfo_new (bt,
-				    kt,
-				    0,
-				    (bt == FFEINFO_basictypeNONE)
-				    ? FFEINFO_kindSUBROUTINE
-				    : FFEINFO_kindFUNCTION,
-				    FFEINFO_whereINTRINSIC,
-				    sz));
-
-      if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
-	  && (((bt != ffesymbol_basictype (ffebld_symter (symter)))
-	       || (kt != ffesymbol_kindtype (ffebld_symter (symter)))
-	       || ((sz != FFETARGET_charactersizeNONE)
-		   && (sz != ffesymbol_size (ffebld_symter (symter)))))))
-	{
-	  ffebad_start (FFEBAD_INTRINSIC_TYPE);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (ffeintrin_gens_[gen].name);
-	  ffebad_finish ();
-	}
-      if (ffeintrin_imps_[imp].y2kbad)
-	{
-	  ffebad_start (FFEBAD_INTRINSIC_Y2KBAD);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (ffeintrin_gens_[gen].name);
-	  ffebad_finish ();
-	}
-    }
-}
-
-/* Check and fill in info on func/subr ref node.
-
-   ffebld expr;			// FUNCREF or SUBRREF with no info (caller
-				// gets it from the modified info structure).
-   ffeinfo info;		// Already filled in, will be overwritten.
-   bool check_intrin;           // May be omitted, else set TRUE if intrinsic needs checking.
-   ffelexToken token;		// Used for error message.
-   ffeintrin_fulfill_specific (&expr, &info, &check_intrin, token);
-
-   Based on the specific id, determine whether the arg list is valid
-   (number, type, rank, and kind of args) and fill in the info structure
-   accordingly.	 Currently don't rewrite the expression, but perhaps
-   someday do so for constant collapsing, except when an error occurs,
-   in which case it is overwritten with ANY and info is also overwritten
-   accordingly.	 */
-
-void
-ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
-			    bool *check_intrin, ffelexToken t)
-{
-  ffebld symter;
-  ffebldOp op;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-  ffeinfoBasictype bt = FFEINFO_basictypeNONE;
-  ffeinfoKindtype kt = FFEINFO_kindtypeNONE;
-  ffetargetCharacterSize sz = FFETARGET_charactersizeNONE;
-  ffeIntrinsicState state;
-  ffebad error;
-  bool any = FALSE;
-  const char *name;
-
-  op = ffebld_op (*expr);
-  assert ((op == FFEBLD_opFUNCREF) || (op == FFEBLD_opSUBRREF));
-  assert (ffebld_op (ffebld_left (*expr)) == FFEBLD_opSYMTER);
-
-  gen = ffebld_symter_generic (ffebld_left (*expr));
-  spec = ffebld_symter_specific (ffebld_left (*expr));
-  assert (spec != FFEINTRIN_specNONE);
-
-  if (gen != FFEINTRIN_genNONE)
-    name = ffeintrin_gens_[gen].name;
-  else
-    name = ffeintrin_specs_[spec].name;
-
-  state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
-
-  imp = ffeintrin_specs_[spec].implementation;
-  if (check_intrin != NULL)
-    *check_intrin = FALSE;
-
-  any = ffeintrin_check_any_ (ffebld_right (*expr));
-
-  if (state == FFE_intrinsicstateDISABLED)
-    error = FFEBAD_INTRINSIC_DISABLED;
-  else if (imp == FFEINTRIN_impNONE)
-    error = FFEBAD_INTRINSIC_UNIMPL;
-  else if (!any)
-    {
-      error = ffeintrin_check_ (imp, ffebld_op (*expr),
-				ffebld_right (*expr),
-				&bt, &kt, &sz, check_intrin, t, TRUE);
-    }
-  else
-    error = FFEBAD;	/* Not really needed, but quiet -Wuninitialized. */
-
-  if (any || (error != FFEBAD))
-    {
-      if (!any)
-	{
-
-	  ffebad_start (error);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (name);
-	  ffebad_finish ();
-	}
-
-      *expr = ffebld_new_any ();
-      *info = ffeinfo_new_any ();
-    }
-  else
-    {
-      *info = ffeinfo_new (bt,
-			   kt,
-			   0,
-			   FFEINFO_kindENTITY,
-			   FFEINFO_whereFLEETING,
-			   sz);
-      symter = ffebld_left (*expr);
-      ffebld_set_info (symter,
-		       ffeinfo_new (bt,
-				    kt,
-				    0,
-				    (bt == FFEINFO_basictypeNONE)
-				    ? FFEINFO_kindSUBROUTINE
-				    : FFEINFO_kindFUNCTION,
-				    FFEINFO_whereINTRINSIC,
-				    sz));
-
-      if ((ffesymbol_attrs (ffebld_symter (symter)) & FFESYMBOL_attrsTYPE)
-	  && (((bt != ffesymbol_basictype (ffebld_symter (symter)))
-	       || (kt != ffesymbol_kindtype (ffebld_symter (symter)))
-	       || (sz != ffesymbol_size (ffebld_symter (symter))))))
-	{
-	  ffebad_start (FFEBAD_INTRINSIC_TYPE);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (name);
-	  ffebad_finish ();
-	}
-      if (ffeintrin_imps_[imp].y2kbad)
-	{
-	  ffebad_start (FFEBAD_INTRINSIC_Y2KBAD);
-	  ffebad_here (0, ffelex_token_where_line (t),
-		       ffelex_token_where_column (t));
-	  ffebad_string (name);
-	  ffebad_finish ();
-	}
-    }
-}
-
-/* Return run-time index of intrinsic implementation as direct call.  */
-
-ffecomGfrt
-ffeintrin_gfrt_direct (ffeintrinImp imp)
-{
-  assert (imp < FFEINTRIN_imp);
-
-  return ffeintrin_imps_[imp].gfrt_direct;
-}
-
-/* Return run-time index of intrinsic implementation as actual argument.  */
-
-ffecomGfrt
-ffeintrin_gfrt_indirect (ffeintrinImp imp)
-{
-  assert (imp < FFEINTRIN_imp);
-
-  if (! ffe_is_f2c ())
-    return ffeintrin_imps_[imp].gfrt_gnu;
-  return ffeintrin_imps_[imp].gfrt_f2c;
-}
-
-void
-ffeintrin_init_0 (void)
-{
-  int i;
-  const char *p1;
-  const char *p2;
-  const char *p3;
-  int colon;
-
-  if (!ffe_is_do_internal_checks ())
-    return;
-
-  assert (FFEINTRIN_gen == ARRAY_SIZE (ffeintrin_gens_));
-  assert (FFEINTRIN_imp == ARRAY_SIZE (ffeintrin_imps_));
-  assert (FFEINTRIN_spec == ARRAY_SIZE (ffeintrin_specs_));
-
-  for (i = 1; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
-    {				/* Make sure binary-searched list is in alpha
-				   order. */
-      if (strcmp (ffeintrin_names_[i - 1].name_uc,
-		  ffeintrin_names_[i].name_uc) >= 0)
-	assert ("name list out of order" == NULL);
-    }
-
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_names_); ++i)
-    {
-      assert ((ffeintrin_names_[i].generic == FFEINTRIN_genNONE)
-	      || (ffeintrin_names_[i].specific == FFEINTRIN_specNONE));
-
-      p1 = ffeintrin_names_[i].name_uc;
-      p2 = ffeintrin_names_[i].name_lc;
-      p3 = ffeintrin_names_[i].name_ic;
-      for (; *p1 != '\0' && *p2 != '\0' && *p3 != '\0'; ++p1, ++p2, ++p3)
-	{
-	  if ((ISDIGIT (*p1) || (*p1 == '_')) && (*p1 == *p2) && (*p1 == *p3))
-	    continue;
-	  if (! ISUPPER ((unsigned char)*p1) || ! ISLOWER ((unsigned char)*p2)
-	      || (*p1 != TOUPPER (*p2))
-	      || ((*p3 != *p1) && (*p3 != *p2)))
-	    break;
-	}
-      assert ((*p1 == *p2) && (*p1 == *p3) && (*p1 == '\0'));
-    }
-
-  for (i = 0; ((size_t) i) < ARRAY_SIZE (ffeintrin_imps_); ++i)
-    {
-      const char *c = ffeintrin_imps_[i].control;
-
-      if (c[0] == '\0')
-	continue;
-
-      if ((c[0] != '-')
-	  && (c[0] != 'A')
-	  && (c[0] != 'C')
-	  && (c[0] != 'I')
-	  && (c[0] != 'L')
-	  && (c[0] != 'R')
-	  && (c[0] != 'B')
-	  && (c[0] != 'F')
-	  && (c[0] != 'N')
-	  && (c[0] != 'S'))
-	{
-	  fprintf (stderr, "%s: bad return-base-type\n",
-		   ffeintrin_imps_[i].name);
-	  continue;
-	}
-      if ((c[1] != '-')
-	  && (c[1] != '=')
-	  && ((c[1] < '1')
-	      || (c[1] > '9'))
-	  && (c[1] != 'C'))
-	{
-	  fprintf (stderr, "%s: bad return-kind-type\n",
-		   ffeintrin_imps_[i].name);
-	  continue;
-	}
-      if (c[2] == ':')
-	colon = 2;
-      else
-	{
-	  if (c[2] != '*')
-	    {
-	      fprintf (stderr, "%s: bad return-modifier\n",
-		       ffeintrin_imps_[i].name);
-	      continue;
-	    }
-	  colon = 3;
-	}
-      if ((c[colon] != ':') || (c[colon + 2] != ':'))
-	{
-	  fprintf (stderr, "%s: bad control\n",
-		   ffeintrin_imps_[i].name);
-	  continue;
-	}
-      if ((c[colon + 1] != '-')
-	  && (c[colon + 1] != '*')
-	  && (! ISDIGIT (c[colon + 1])))
-	{
-	  fprintf (stderr, "%s: bad COL-spec\n",
-		   ffeintrin_imps_[i].name);
-	  continue;
-	}
-      c += (colon + 3);
-      while (c[0] != '\0')
-	{
-	  while ((c[0] != '=')
-		 && (c[0] != ',')
-		 && (c[0] != '\0'))
-	    ++c;
-	  if (c[0] != '=')
-	    {
-	      fprintf (stderr, "%s: bad keyword\n",
-		       ffeintrin_imps_[i].name);
-	      break;
-	    }
-	  if ((c[1] == '?')
-	      || (c[1] == '!')
-	      || (c[1] == '+')
-	      || (c[1] == '*')
-	      || (c[1] == 'n')
-	      || (c[1] == 'p'))
-	    ++c;
-	  if ((c[1] != '-')
-	      && (c[1] != 'A')
-	      && (c[1] != 'C')
-	      && (c[1] != 'I')
-	      && (c[1] != 'L')
-	      && (c[1] != 'R')
-	      && (c[1] != 'B')
-	      && (c[1] != 'F')
-	      && (c[1] != 'N')
-	      && (c[1] != 'S')
-	      && (c[1] != 'g')
-	      && (c[1] != 's'))
-	    {
-	      fprintf (stderr, "%s: bad arg-base-type\n",
-		       ffeintrin_imps_[i].name);
-	      break;
-	    }
-	  if ((c[2] != '*')
-	      && ((c[2] < '1')
-		  || (c[2] > '9'))
-	      && (c[2] != 'A'))
-	    {
-	      fprintf (stderr, "%s: bad arg-kind-type\n",
-		       ffeintrin_imps_[i].name);
-	      break;
-	    }
-	  if (c[3] == '[')
-	    {
-	      if ((! ISDIGIT (c[4]))
-		  || ((c[5] != ']')
-		      && (++c, ! ISDIGIT (c[4])
-			  || (c[5] != ']'))))
-		{
-		  fprintf (stderr, "%s: bad arg-len\n",
-			   ffeintrin_imps_[i].name);
-		  break;
-		}
-	      c += 3;
-	    }
-	  if (c[3] == '(')
-	    {
-	      if ((! ISDIGIT (c[4]))
-		  || ((c[5] != ')')
-		      && (++c, ! ISDIGIT (c[4])
-			  || (c[5] != ')'))))
-		{
-		  fprintf (stderr, "%s: bad arg-rank\n",
-			   ffeintrin_imps_[i].name);
-		  break;
-		}
-	      c += 3;
-	    }
-	  else if ((c[3] == '&')
-		   && (c[4] == '&'))
-	    ++c;
-	  if ((c[3] == '&')
-	      || (c[3] == 'i')
-	      || (c[3] == 'w')
-	      || (c[3] == 'x'))
-	    ++c;
-	  if (c[3] == ',')
-	    {
-	      c += 4;
-	      continue;
-	    }
-	  if (c[3] != '\0')
-	    {
-	      fprintf (stderr, "%s: bad arg-list\n",
-		       ffeintrin_imps_[i].name);
-	    }
-	  break;
-	}
-    }
-}
-
-/* Determine whether intrinsic is okay as an actual argument.  */
-
-bool
-ffeintrin_is_actualarg (ffeintrinSpec spec)
-{
-  ffeIntrinsicState state;
-
-  if (spec >= FFEINTRIN_spec)
-    return FALSE;
-
-  state = ffeintrin_state_family (ffeintrin_specs_[spec].family);
-
-  return (!ffe_is_pedantic () || ffeintrin_specs_[spec].is_actualarg)
-    && (ffe_is_f2c ()
-	? (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_f2c
-	   != FFECOM_gfrt)
-	: (ffeintrin_imps_[ffeintrin_specs_[spec].implementation].gfrt_gnu
-	   != FFECOM_gfrt))
-    && ((state == FFE_intrinsicstateENABLED)
-	|| (state == FFE_intrinsicstateHIDDEN));
-}
-
-/* Determine if name is intrinsic, return info.
-
-   const char *name;		// C-string name of possible intrinsic.
-   ffelexToken t;		// NULL if no diagnostic to be given.
-   bool explicit;		// TRUE if INTRINSIC name.
-   ffeintrinGen gen;		// (TRUE only) Generic id of intrinsic.
-   ffeintrinSpec spec;		// (TRUE only) Specific id of intrinsic.
-   ffeintrinImp imp;		// (TRUE only) Implementation id of intrinsic.
-   if (ffeintrin_is_intrinsic (name, t, explicit,
-			       &gen, &spec, &imp))
-				// is an intrinsic, use gen, spec, imp, and
-				// kind accordingly.  */
-
-bool
-ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
-			ffeintrinGen *xgen, ffeintrinSpec *xspec,
-			ffeintrinImp *ximp)
-{
-  struct _ffeintrin_name_ *intrinsic;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-  ffeIntrinsicState state;
-  bool disabled = FALSE;
-  bool unimpl = FALSE;
-
-  intrinsic = bsearch (name, &ffeintrin_names_[0],
-		       ARRAY_SIZE (ffeintrin_names_),
-		       sizeof (struct _ffeintrin_name_),
-		         (void *) ffeintrin_cmp_name_);
-
-  if (intrinsic == NULL)
-    return FALSE;
-
-  gen = intrinsic->generic;
-  spec = intrinsic->specific;
-  imp = ffeintrin_specs_[spec].implementation;
-
-  /* Generic is okay only if at least one of its specifics is okay.  */
-
-  if (gen != FFEINTRIN_genNONE)
-    {
-      int i;
-      ffeintrinSpec tspec;
-      bool ok = FALSE;
-
-      name = ffeintrin_gens_[gen].name;
-
-      for (i = 0;
-	   (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
-	   && ((tspec
-		= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
-	   ++i)
-	{
-	  state = ffeintrin_state_family (ffeintrin_specs_[tspec].family);
-
-	  if (state == FFE_intrinsicstateDELETED)
-	    continue;
-
-	  if (state == FFE_intrinsicstateDISABLED)
-	    {
-	      disabled = TRUE;
-	      continue;
-	    }
-
-	  if (ffeintrin_specs_[tspec].implementation == FFEINTRIN_impNONE)
-	    {
-	      unimpl = TRUE;
-	      continue;
-	    }
-
-	  if ((state == FFE_intrinsicstateENABLED)
-	      || (explicit
-		  && (state == FFE_intrinsicstateHIDDEN)))
-	    {
-	      ok = TRUE;
-	      break;
-	    }
-	}
-      if (!ok)
-	gen = FFEINTRIN_genNONE;
-    }
-
-  /* Specific is okay only if not: unimplemented, disabled, deleted, or
-     hidden and not explicit.  */
-
-  if (spec != FFEINTRIN_specNONE)
-    {
-      if (gen != FFEINTRIN_genNONE)
-	name = ffeintrin_gens_[gen].name;
-      else
-	name = ffeintrin_specs_[spec].name;
-
-      if (((state = ffeintrin_state_family (ffeintrin_specs_[spec].family))
-	   == FFE_intrinsicstateDELETED)
-	  || (!explicit
-	      && (state == FFE_intrinsicstateHIDDEN)))
-	spec = FFEINTRIN_specNONE;
-      else if (state == FFE_intrinsicstateDISABLED)
-	{
-	  disabled = TRUE;
-	  spec = FFEINTRIN_specNONE;
-	}
-      else if (imp == FFEINTRIN_impNONE)
-	{
-	  unimpl = TRUE;
-	  spec = FFEINTRIN_specNONE;
-	}
-    }
-
-  /* If neither is okay, not an intrinsic.  */
-
-  if ((gen == FFEINTRIN_genNONE) && (spec == FFEINTRIN_specNONE))
-    {
-      /* Here is where we produce a diagnostic about a reference to a
-	 disabled or unimplemented intrinsic, if the diagnostic is desired.  */
-
-      if ((disabled || unimpl)
-	  && (t != NULL))
-	{
-	  ffebad_start (disabled
-			? FFEBAD_INTRINSIC_DISABLED
-			: FFEBAD_INTRINSIC_UNIMPLW);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_string (name);
-	  ffebad_finish ();
-	}
-
-      return FALSE;
-    }
-
-  /* Determine whether intrinsic is function or subroutine.  If no specific
-     id, scan list of possible specifics for generic to get consensus.  If
-     not unanimous, or clear from the context, return NONE.  */
-
-  if (spec == FFEINTRIN_specNONE)
-    {
-      int i;
-      ffeintrinSpec tspec;
-      ffeintrinImp timp;
-      bool at_least_one_ok = FALSE;
-
-      for (i = 0;
-	   (((size_t) i) < ARRAY_SIZE (ffeintrin_gens_[gen].specs))
-	   && ((tspec
-		= ffeintrin_gens_[gen].specs[i]) != FFEINTRIN_specNONE);
-	   ++i)
-	{
-	  if (((state = ffeintrin_state_family (ffeintrin_specs_[tspec].family))
-	       == FFE_intrinsicstateDELETED)
-	      || (state == FFE_intrinsicstateDISABLED))
-	    continue;
-
-	  if ((timp = ffeintrin_specs_[tspec].implementation)
-	      == FFEINTRIN_impNONE)
-	    continue;
-
-	  at_least_one_ok = TRUE;
-	  break;
-	}
-
-      if (!at_least_one_ok)
-	{
-	  *xgen = FFEINTRIN_genNONE;
-	  *xspec = FFEINTRIN_specNONE;
-	  *ximp = FFEINTRIN_impNONE;
-	  return FALSE;
-	}
-    }
-
-  *xgen = gen;
-  *xspec = spec;
-  *ximp = imp;
-  return TRUE;
-}
-
-/* Return TRUE if intrinsic is standard F77 (or, if -ff90, F90).  */
-
-bool
-ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec)
-{
-  if (spec == FFEINTRIN_specNONE)
-    {
-      if (gen == FFEINTRIN_genNONE)
-	return FALSE;
-
-      spec = ffeintrin_gens_[gen].specs[0];
-      if (spec == FFEINTRIN_specNONE)
-	return FALSE;
-    }
-
-  if ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF77)
-      || (ffe_is_90 ()
-	  && ((ffeintrin_specs_[spec].family == FFEINTRIN_familyF90)
-	      || (ffeintrin_specs_[spec].family == FFEINTRIN_familyMIL)
-	      || (ffeintrin_specs_[spec].family == FFEINTRIN_familyASC))))
-    return TRUE;
-  return FALSE;
-}
-
-/* Return kind type of intrinsic implementation.  See ffeintrin_basictype,
-   its sibling.  */
-
-ffeinfoKindtype
-ffeintrin_kindtype (ffeintrinSpec spec)
-{
-  ffeintrinImp imp;
-  ffecomGfrt gfrt;
-
-  assert (spec < FFEINTRIN_spec);
-  imp = ffeintrin_specs_[spec].implementation;
-  assert (imp < FFEINTRIN_imp);
-
-  if (ffe_is_f2c ())
-    gfrt = ffeintrin_imps_[imp].gfrt_f2c;
-  else
-    gfrt = ffeintrin_imps_[imp].gfrt_gnu;
-
-  assert (gfrt != FFECOM_gfrt);
-
-  return ffecom_gfrt_kindtype (gfrt);
-}
-
-/* Return name of generic intrinsic.  */
-
-const char *
-ffeintrin_name_generic (ffeintrinGen gen)
-{
-  assert (gen < FFEINTRIN_gen);
-  return ffeintrin_gens_[gen].name;
-}
-
-/* Return name of intrinsic implementation.  */
-
-const char *
-ffeintrin_name_implementation (ffeintrinImp imp)
-{
-  assert (imp < FFEINTRIN_imp);
-  return ffeintrin_imps_[imp].name;
-}
-
-/* Return external/internal name of specific intrinsic.	 */
-
-const char *
-ffeintrin_name_specific (ffeintrinSpec spec)
-{
-  assert (spec < FFEINTRIN_spec);
-  return ffeintrin_specs_[spec].name;
-}
-
-/* Return state of family.  */
-
-ffeIntrinsicState
-ffeintrin_state_family (ffeintrinFamily family)
-{
-  ffeIntrinsicState state;
-
-  switch (family)
-    {
-    case FFEINTRIN_familyNONE:
-      return FFE_intrinsicstateDELETED;
-
-    case FFEINTRIN_familyF77:
-      return FFE_intrinsicstateENABLED;
-
-    case FFEINTRIN_familyASC:
-      state = ffe_intrinsic_state_f2c ();
-      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
-      return state;
-
-    case FFEINTRIN_familyMIL:
-      state = ffe_intrinsic_state_vxt ();
-      state = ffe_state_max (state, ffe_intrinsic_state_f90 ());
-      state = ffe_state_max (state, ffe_intrinsic_state_mil ());
-      return state;
-
-    case FFEINTRIN_familyGNU:
-      state = ffe_intrinsic_state_gnu ();
-      return state;
-
-    case FFEINTRIN_familyF90:
-      state = ffe_intrinsic_state_f90 ();
-      return state;
-
-    case FFEINTRIN_familyVXT:
-      state = ffe_intrinsic_state_vxt ();
-      return state;
-
-    case FFEINTRIN_familyFVZ:
-      state = ffe_intrinsic_state_f2c ();
-      state = ffe_state_max (state, ffe_intrinsic_state_vxt ());
-      return state;
-
-    case FFEINTRIN_familyF2C:
-      state = ffe_intrinsic_state_f2c ();
-      return state;
-
-    case FFEINTRIN_familyF2U:
-      state = ffe_intrinsic_state_unix ();
-      return state;
-
-    case FFEINTRIN_familyBADU77:
-      state = ffe_intrinsic_state_badu77 ();
-      return state;
-
-    default:
-      assert ("bad family" == NULL);
-      return FFE_intrinsicstateDELETED;
-    }
-}
diff --git a/gcc/f/intrin.def b/gcc/f/intrin.def
deleted file mode 100644
index 5d712ba..0000000
--- a/gcc/f/intrin.def
+++ /dev/null
@@ -1,3358 +0,0 @@
-/* intrin.def -- Public #include File (module.h template V1.0)
-   The Free Software Foundation has released this file into the
-   public domain.
-
-   Owning Modules:
-      intrin.c
-
-   Modifications:
-*/
-
-/* Intrinsic names listed in alphabetical order, sorted by uppercase name.
-   This list is keyed to the names of intrinsics as seen in source code.  */
-
-DEFNAME	("ABORT",	"abort",	"Abort",	genNONE,	specABORT)	/* UNIX */
-DEFNAME	("ABS",		"abs",		"Abs",		genNONE,	specABS)
-DEFNAME	("ACCESS",	"access",	"Access",	genNONE,	specACCESS)	/* UNIX */
-DEFNAME	("ACHAR",	"achar",	"AChar",	genNONE,	specACHAR)	/* F90,	F2C */
-DEFNAME	("ACOS",	"acos",		"ACos",		genNONE,	specACOS)
-DEFNAME	("ACOSD",	"acosd",	"ACosD",	genNONE,	specACOSD)	/* VXT */
-DEFNAME	("ADJUSTL",	"adjustl",	"AdjustL",	genNONE,	specADJUSTL)	/* F90 */
-DEFNAME	("ADJUSTR",	"adjustr",	"AdjustR",	genNONE,	specADJUSTR)	/* F90 */
-DEFNAME	("AIMAG",	"aimag",	"AImag",	genNONE,	specAIMAG)
-DEFNAME	("AIMAX0",	"aimax0",	"AIMax0",	genNONE,	specAIMAX0)	/* VXT */
-DEFNAME	("AIMIN0",	"aimin0",	"AIMin0",	genNONE,	specAIMIN0)	/* VXT */
-DEFNAME	("AINT",	"aint",		"AInt",		genNONE,	specAINT)
-DEFNAME	("AJMAX0",	"ajmax0",	"AJMax0",	genNONE,	specAJMAX0)	/* VXT */
-DEFNAME	("AJMIN0",	"ajmin0",	"AJMin0",	genNONE,	specAJMIN0)	/* VXT */
-DEFNAME	("ALARM",	"alarm",	"Alarm",	genNONE,	specALARM)	/* UNIX */
-DEFNAME	("ALL",		"all",		"All",		genNONE,	specALL)	/* F90 */
-DEFNAME	("ALLOCATED",	"allocated",	"Allocated",	genNONE,	specALLOCATED)	/* F90 */
-DEFNAME	("ALOG",	"alog",		"ALog",		genNONE,	specALOG)
-DEFNAME	("ALOG10",	"alog10",	"ALog10",	genNONE,	specALOG10)
-DEFNAME	("AMAX0",	"amax0",	"AMax0",	genNONE,	specAMAX0)
-DEFNAME	("AMAX1",	"amax1",	"AMax1",	genNONE,	specAMAX1)
-DEFNAME	("AMIN0",	"amin0",	"AMin0",	genNONE,	specAMIN0)
-DEFNAME	("AMIN1",	"amin1",	"AMin1",	genNONE,	specAMIN1)
-DEFNAME	("AMOD",	"amod",		"AMod",		genNONE,	specAMOD)
-DEFNAME	("AND",		"and",		"And",		genNONE,	specAND)	/* F2C */
-DEFNAME	("ANINT",	"anint",	"ANInt",	genNONE,	specANINT)
-DEFNAME	("ANY",		"any",		"Any",		genNONE,	specANY)	/* F90 */
-DEFNAME	("ASIN",	"asin",		"ASin",		genNONE,	specASIN)
-DEFNAME	("ASIND",	"asind",	"ASinD",	genNONE,	specASIND)	/* VXT */
-DEFNAME	("ASSOCIATED",	"associated",	"Associated",	genNONE,	specASSOCIATED)	/* F90 */
-DEFNAME	("ATAN",	"atan",		"ATan",		genNONE,	specATAN)
-DEFNAME	("ATAN2",	"atan2",	"ATan2",	genNONE,	specATAN2)
-DEFNAME	("ATAN2D",	"atan2d",	"ATan2D",	genNONE,	specATAN2D)	/* VXT */
-DEFNAME	("ATAND",	"atand",	"ATanD",	genNONE,	specATAND)	/* VXT */
-DEFNAME	("BESJ0",	"besj0",	"BesJ0",	genNONE,	specBESJ0)	/* UNIX */
-DEFNAME	("BESJ1",	"besj1",	"BesJ1",	genNONE,	specBESJ1)	/* UNIX */
-DEFNAME	("BESJN",	"besjn",	"BesJN",	genNONE,	specBESJN)	/* UNIX */
-DEFNAME	("BESY0",	"besy0",	"BesY0",	genNONE,	specBESY0)	/* UNIX */
-DEFNAME	("BESY1",	"besy1",	"BesY1",	genNONE,	specBESY1)	/* UNIX */
-DEFNAME	("BESYN",	"besyn",	"BesYN",	genNONE,	specBESYN)	/* UNIX */
-DEFNAME	("BITEST",	"bitest",	"BITest",	genNONE,	specBITEST)	/* VXT */
-DEFNAME	("BIT_SIZE",	"bit_size",	"Bit_Size",	genNONE,	specBIT_SIZE)	/* F90 */
-DEFNAME	("BJTEST",	"bjtest",	"BJTest",	genNONE,	specBJTEST)	/* VXT */
-DEFNAME	("BTEST",	"btest",	"BTest",	genNONE,	specBTEST)	/* F90,	VXT */
-DEFNAME	("CABS",	"cabs",		"CAbs",		genNONE,	specCABS)
-DEFNAME	("CCOS",	"ccos",		"CCos",		genNONE,	specCCOS)
-DEFNAME	("CDABS",	"cdabs",	"CDAbs",	genNONE,	specCDABS)	/* VXT */
-DEFNAME	("CDCOS",	"cdcos",	"CDCos",	genNONE,	specCDCOS)	/* VXT */
-DEFNAME	("CDEXP",	"cdexp",	"CDExp",	genNONE,	specCDEXP)	/* VXT */
-DEFNAME	("CDLOG",	"cdlog",	"CDLog",	genNONE,	specCDLOG)	/* VXT */
-DEFNAME	("CDSIN",	"cdsin",	"CDSin",	genNONE,	specCDSIN)	/* VXT */
-DEFNAME	("CDSQRT",	"cdsqrt",	"CDSqRt",	genNONE,	specCDSQRT)	/* VXT */
-DEFNAME	("CEILING",	"ceiling",	"Ceiling",	genNONE,	specCEILING)	/* F90 */
-DEFNAME	("CEXP",	"cexp",		"CExp",		genNONE,	specCEXP)
-DEFNAME	("CHAR",	"char",		"Char",		genNONE,	specCHAR)
-DEFNAME	("CHDIR",	"chdir",	"ChDir",	genCHDIR,	specNONE)	/* UNIX */
-DEFNAME	("CHMOD",	"chmod",	"ChMod",	genCHMOD,	specNONE)	/* UNIX */
-DEFNAME	("CLOG",	"clog",		"CLog",		genNONE,	specCLOG)
-DEFNAME	("CMPLX",	"cmplx",	"Cmplx",	genNONE,	specCMPLX)
-DEFNAME	("COMPLEX",	"complex",	"Complex",	genNONE,	specCOMPLEX)
-DEFNAME	("CONJG",	"conjg",	"Conjg",	genNONE,	specCONJG)
-DEFNAME	("COS",		"cos",		"Cos",		genNONE,	specCOS)
-DEFNAME	("COSD",	"cosd",		"CosD",		genNONE,	specCOSD)	/* VXT */
-DEFNAME	("COSH",	"cosh",		"CosH",		genNONE,	specCOSH)
-DEFNAME	("COUNT",	"count",	"Count",	genNONE,	specCOUNT)	/* F90 */
-DEFNAME	("CPU_TIME",	"cpu_time",	"CPU_Time",	genNONE,	specCPU_TIME)	/* F95 */
-DEFNAME	("CSHIFT",	"cshift",	"CShift",	genNONE,	specCSHIFT)	/* F90 */
-DEFNAME	("CSIN",	"csin",		"CSin",		genNONE,	specCSIN)
-DEFNAME	("CSQRT",	"csqrt",	"CSqRt",	genNONE,	specCSQRT)
-DEFNAME	("CTIME",	"ctime",	"CTime",	genCTIME,	specNONE)	/* UNIX */
-DEFNAME	("DABS",	"dabs",		"DAbs",		genNONE,	specDABS)
-DEFNAME	("DACOS",	"dacos",	"DACos",	genNONE,	specDACOS)
-DEFNAME	("DACOSD",	"dacosd",	"DACosD",	genNONE,	specDACOSD)	/* VXT */
-DEFNAME	("DASIN",	"dasin",	"DASin",	genNONE,	specDASIN)
-DEFNAME	("DASIND",	"dasind",	"DASinD",	genNONE,	specDASIND)	/* VXT */
-DEFNAME	("DATAN",	"datan",	"DATan",	genNONE,	specDATAN)
-DEFNAME	("DATAN2",	"datan2",	"DATan2",	genNONE,	specDATAN2)
-DEFNAME	("DATAN2D",	"datan2d",	"DATan2D",	genNONE,	specDATAN2D)	/* VXT */
-DEFNAME	("DATAND",	"datand",	"DATanD",	genNONE,	specDATAND)	/* VXT */
-DEFNAME	("DATE",	"date",		"Date",		genNONE,	specDATE)	/* VXT */
-DEFNAME	("DATE_AND_TIME",	"date_and_time",	"Date_and_Time",	genNONE,	specDATE_AND_TIME)	/* F90 */
-DEFNAME	("DBESJ0",	"dbesj0",	"DbesJ0",	genNONE,	specDBESJ0)	/* UNIX */
-DEFNAME	("DBESJ1",	"dbesj1",	"DbesJ1",	genNONE,	specDBESJ1)	/* UNIX */
-DEFNAME	("DBESJN",	"dbesjn",	"DbesJN",	genNONE,	specDBESJN)	/* UNIX */
-DEFNAME	("DBESY0",	"dbesy0",	"DbesY0",	genNONE,	specDBESY0)	/* UNIX */
-DEFNAME	("DBESY1",	"dbesy1",	"DbesY1",	genNONE,	specDBESY1)	/* UNIX */
-DEFNAME	("DBESYN",	"dbesyn",	"DbesYN",	genNONE,	specDBESYN)	/* UNIX */
-DEFNAME	("DBLE",	"dble",		"Dble",		genNONE,	specDBLE)
-DEFNAME	("DBLEQ",	"dbleq",	"DbleQ",	genNONE,	specDBLEQ)	/* VXT */
-DEFNAME	("DCMPLX",	"dcmplx",	"DCmplx",	genNONE,	specDCMPLX)	/* F2C,	VXT */
-DEFNAME	("DCONJG",	"dconjg",	"DConjg",	genNONE,	specDCONJG)	/* F2C,	VXT */
-DEFNAME	("DCOS",	"dcos",		"DCos",		genNONE,	specDCOS)
-DEFNAME	("DCOSD",	"dcosd",	"DCosD",	genNONE,	specDCOSD)	/* VXT */
-DEFNAME	("DCOSH",	"dcosh",	"DCosH",	genNONE,	specDCOSH)
-DEFNAME	("DDIM",	"ddim",		"DDiM",		genNONE,	specDDIM)
-DEFNAME	("DERF",	"derf",		"DErF",		genNONE,	specDERF)	/* UNIX */
-DEFNAME	("DERFC",	"derfc",	"DErFC",	genNONE,	specDERFC)	/* UNIX */
-DEFNAME	("DEXP",	"dexp",		"DExp",		genNONE,	specDEXP)
-DEFNAME	("DFLOAT",	"dfloat",	"DFloat",	genNONE,	specDFLOAT)	/* F2C,	VXT */
-DEFNAME	("DFLOTI",	"dfloti",	"DFlotI",	genNONE,	specDFLOTI)	/* VXT */
-DEFNAME	("DFLOTJ",	"dflotj",	"DFlotJ",	genNONE,	specDFLOTJ)	/* VXT */
-DEFNAME	("DIGITS",	"digits",	"Digits",	genNONE,	specDIGITS)	/* F90 */
-DEFNAME	("DIM",		"dim",		"DiM",		genNONE,	specDIM)
-DEFNAME	("DIMAG",	"dimag",	"DImag",	genNONE,	specDIMAG)	/* F2C, VXT */
-DEFNAME	("DINT",	"dint",		"DInt",		genNONE,	specDINT)
-DEFNAME	("DLOG",	"dlog",		"DLog",		genNONE,	specDLOG)
-DEFNAME	("DLOG10",	"dlog10",	"DLog10",	genNONE,	specDLOG10)
-DEFNAME	("DMAX1",	"dmax1",	"DMax1",	genNONE,	specDMAX1)
-DEFNAME	("DMIN1",	"dmin1",	"DMin1",	genNONE,	specDMIN1)
-DEFNAME	("DMOD",	"dmod",		"DMod",		genNONE,	specDMOD)
-DEFNAME	("DNINT",	"dnint",	"DNInt",	genNONE,	specDNINT)
-DEFNAME	("DOT_PRODUCT",	"dot_product",	"Dot_Product",	genNONE,	specDOT_PRODUCT)	/* F90 */
-DEFNAME	("DPROD",	"dprod",	"DProd",	genNONE,	specDPROD)
-DEFNAME	("DREAL",	"dreal",	"DReal",	genNONE,	specDREAL)	/* VXT */
-DEFNAME	("DSIGN",	"dsign",	"DSign",	genNONE,	specDSIGN)
-DEFNAME	("DSIN",	"dsin",		"DSin",		genNONE,	specDSIN)
-DEFNAME	("DSIND",	"dsind",	"DSinD",	genNONE,	specDSIND)	/* VXT */
-DEFNAME	("DSINH",	"dsinh",	"DSinH",	genNONE,	specDSINH)
-DEFNAME	("DSQRT",	"dsqrt",	"DSqRt",	genNONE,	specDSQRT)
-DEFNAME	("DTAN",	"dtan",		"DTan",		genNONE,	specDTAN)
-DEFNAME	("DTAND",	"dtand",	"DTanD",	genNONE,	specDTAND)	/* VXT */
-DEFNAME	("DTANH",	"dtanh",	"DTanH",	genNONE,	specDTANH)
-DEFNAME	("DTIME",	"dtime",	"DTime",	genDTIME,	specNONE)	/* UNIX */
-DEFNAME	("EOSHIFT",	"eoshift",	"EOShift",	genNONE,	specEOSHIFT)	/* F90 */
-DEFNAME	("EPSILON",	"epsilon",	"Epsilon",	genNONE,	specEPSILON)	/* F90 */
-DEFNAME	("ERF",		"erf",		"ErF",		genNONE,	specERF)	/* UNIX */
-DEFNAME	("ERFC",	"erfc",		"ErFC",		genNONE,	specERFC)	/* UNIX */
-DEFNAME	("ETIME",	"etime",	"ETime",	genETIME,	specNONE)	/* UNIX */
-DEFNAME	("EXIT",	"exit",		"Exit",		genNONE,	specEXIT)	/* UNIX */
-DEFNAME	("EXP",		"exp",		"Exp",		genNONE,	specEXP)
-DEFNAME	("EXPONENT",	"exponent",	"Exponent",	genNONE,	specEXPONENT)	/* F90 */
-DEFNAME	("FDATE",	"fdate",	"FDate",	genFDATE,	specNONE)	/* UNIX */
-DEFNAME	("FGET",	"fget",		"FGet",		genFGET,	specNONE)	/* UNIX */
-DEFNAME	("FGETC",	"fgetc",	"FGetC",	genFGETC,	specNONE)	/* UNIX */
-DEFNAME	("FLOAT",	"float",	"Float",	genNONE,	specFLOAT)
-DEFNAME	("FLOATI",	"floati",	"FloatI",	genNONE,	specFLOATI)	/* VXT */
-DEFNAME	("FLOATJ",	"floatj",	"FloatJ",	genNONE,	specFLOATJ)	/* VXT */
-DEFNAME	("FLOOR",	"floor",	"Floor",	genNONE,	specFLOOR)	/* F90 */
-DEFNAME	("FLUSH",	"flush",	"Flush",	genNONE,	specFLUSH)	/* UNIX */
-DEFNAME	("FNUM",	"fnum",		"FNum",		genNONE,	specFNUM)	/* UNIX */
-DEFNAME	("FPABSP",	"fpabsp",	"FPAbsP",	genFPABSP,	specNONE)	/* F2C */
-DEFNAME	("FPEXPN",	"fpexpn",	"FPExpn",	genFPEXPN,	specNONE)	/* F2C */
-DEFNAME	("FPFRAC",	"fpfrac",	"FPFrac",	genFPFRAC,	specNONE)	/* F2C */
-DEFNAME	("FPMAKE",	"fpmake",	"FPMake",	genFPMAKE,	specNONE)	/* F2C */
-DEFNAME	("FPRRSP",	"fprrsp",	"FPRRSp",	genFPRRSP,	specNONE)	/* F2C */
-DEFNAME	("FPSCAL",	"fpscal",	"FPScal",	genFPSCAL,	specNONE)	/* F2C */
-DEFNAME	("FPUT",	"fput",		"FPut",		genFPUT,	specNONE)	/* UNIX */
-DEFNAME	("FPUTC",	"fputc",	"FPutC",	genFPUTC,	specNONE)	/* UNIX */
-DEFNAME	("FRACTION",	"fraction",	"Fraction",	genNONE,	specFRACTION)	/* F90 */
-DEFNAME	("FSEEK",	"fseek",	"FSeek",	genNONE,	specFSEEK)	/* UNIX */
-DEFNAME	("FSTAT",	"fstat",	"FStat",	genFSTAT,	specNONE)	/* UNIX */
-DEFNAME	("FTELL",	"ftell",	"FTell",	genFTELL,	specNONE)	/* UNIX */
-DEFNAME	("GERROR",	"gerror",	"GError",	genNONE,	specGERROR)	/* UNIX */
-DEFNAME	("GETARG",	"getarg",	"GetArg",	genNONE,	specGETARG)	/* UNIX */
-DEFNAME	("GETCWD",	"getcwd",	"GetCWD",	genGETCWD,	specNONE)	/* UNIX */
-DEFNAME	("GETENV",	"getenv",	"GetEnv",	genNONE,	specGETENV)	/* UNIX */
-DEFNAME	("GETGID",	"getgid",	"GetGId",	genNONE,	specGETGID)	/* UNIX */
-DEFNAME	("GETLOG",	"getlog",	"GetLog",	genNONE,	specGETLOG)	/* UNIX */
-DEFNAME	("GETPID",	"getpid",	"GetPId",	genNONE,	specGETPID)	/* UNIX */
-DEFNAME	("GETUID",	"getuid",	"GetUId",	genNONE,	specGETUID)	/* UNIX */
-DEFNAME	("GMTIME",	"gmtime",	"GMTime",	genNONE,	specGMTIME)	/* UNIX */
-DEFNAME	("HOSTNM",	"hostnm",	"HostNm",	genHOSTNM,	specNONE)	/* UNIX */
-DEFNAME	("HUGE",	"huge",		"Huge",		genNONE,	specHUGE)	/* F90 */
-DEFNAME	("IABS",	"iabs",		"IAbs",		genNONE,	specIABS)
-DEFNAME	("IACHAR",	"iachar",	"IAChar",	genNONE,	specIACHAR)	/* F90,	F2C */
-DEFNAME	("IAND",	"iand",		"IAnd",		genNONE,	specIAND)	/* F90,	VXT */
-DEFNAME	("IARGC",	"iargc",	"IArgC",	genNONE,	specIARGC)	/* UNIX */
-DEFNAME	("IBCLR",	"ibclr",	"IBClr",	genNONE,	specIBCLR)	/* F90,	VXT */
-DEFNAME	("IBITS",	"ibits",	"IBits",	genNONE,	specIBITS)	/* F90,	VXT */
-DEFNAME	("IBSET",	"ibset",	"IBSet",	genNONE,	specIBSET)	/* F90,	VXT */
-DEFNAME	("ICHAR",	"ichar",	"IChar",	genNONE,	specICHAR)
-DEFNAME	("IDATE",	"idate",	"IDate",	genIDATE,	specNONE)	/* UNIX, VXT */
-DEFNAME	("IDIM",	"idim",		"IDiM",		genNONE,	specIDIM)
-DEFNAME	("IDINT",	"idint",	"IDInt",	genNONE,	specIDINT)
-DEFNAME	("IDNINT",	"idnint",	"IDNInt",	genNONE,	specIDNINT)
-DEFNAME	("IEOR",	"ieor",		"IEOr",		genNONE,	specIEOR)	/* F90,	VXT */
-DEFNAME	("IERRNO",	"ierrno",	"IErrNo",	genNONE,	specIERRNO)	/* UNIX */
-DEFNAME	("IFIX",	"ifix",		"IFix",		genNONE,	specIFIX)
-DEFNAME	("IIABS",	"iiabs",	"IIAbs",	genNONE,	specIIABS)	/* VXT */
-DEFNAME	("IIAND",	"iiand",	"IIAnd",	genNONE,	specIIAND)	/* VXT */
-DEFNAME	("IIBCLR",	"iibclr",	"IIBClr",	genNONE,	specIIBCLR)	/* VXT */
-DEFNAME	("IIBITS",	"iibits",	"IIBits",	genNONE,	specIIBITS)	/* VXT */
-DEFNAME	("IIBSET",	"iibset",	"IIBSet",	genNONE,	specIIBSET)	/* VXT */
-DEFNAME	("IIDIM",	"iidim",	"IIDiM",	genNONE,	specIIDIM)	/* VXT */
-DEFNAME	("IIDINT",	"iidint",	"IIDInt",	genNONE,	specIIDINT)	/* VXT */
-DEFNAME	("IIDNNT",	"iidnnt",	"IIDNnt",	genNONE,	specIIDNNT)	/* VXT */
-DEFNAME	("IIEOR",	"iieor",	"IIEOr",	genNONE,	specIIEOR)	/* VXT */
-DEFNAME	("IIFIX",	"iifix",	"IIFix",	genNONE,	specIIFIX)	/* VXT */
-DEFNAME	("IINT",	"iint",		"IInt",		genNONE,	specIINT)	/* VXT */
-DEFNAME	("IIOR",	"iior",		"IIOr",		genNONE,	specIIOR)	/* VXT */
-DEFNAME	("IIQINT",	"iiqint",	"IIQint",	genNONE,	specIIQINT)	/* VXT */
-DEFNAME	("IIQNNT",	"iiqnnt",	"IIQNnt",	genNONE,	specIIQNNT)	/* VXT */
-DEFNAME	("IISHFT",	"iishft",	"IIShft",	genNONE,	specNONE)	/* VXT */
-DEFNAME	("IISHFTC",	"iishftc",	"IIShftC",	genNONE,	specIISHFTC)	/* VXT */
-DEFNAME	("IISIGN",	"iisign",	"IISign",	genNONE,	specIISIGN)	/* VXT */
-DEFNAME	("IMAG",	"imag",		"Imag",		genNONE,	specIMAG)	/* F2C */
-DEFNAME	("IMAGPART",	"imagpart",	"ImagPart",	genNONE,	specIMAGPART)	/* GNU */
-DEFNAME	("IMAX0",	"imax0",	"IMax0",	genNONE,	specIMAX0)	/* VXT */
-DEFNAME	("IMAX1",	"imax1",	"IMax1",	genNONE,	specIMAX1)	/* VXT */
-DEFNAME	("IMIN0",	"imin0",	"IMin0",	genNONE,	specIMIN0)	/* VXT */
-DEFNAME	("IMIN1",	"imin1",	"IMin1",	genNONE,	specIMIN1)	/* VXT */
-DEFNAME	("IMOD",	"imod",		"IMod",		genNONE,	specIMOD)	/* VXT */
-DEFNAME	("INDEX",	"index",	"Index",	genNONE,	specINDEX)
-DEFNAME	("ININT",	"inint",	"INInt",	genNONE,	specININT)	/* VXT */
-DEFNAME	("INOT",	"inot",		"INot",		genNONE,	specINOT)	/* VXT */
-DEFNAME	("INT",		"int",		"Int",		genNONE,	specINT)
-DEFNAME	("INT2",	"int2",		"Int2",		genNONE,	specINT2)	/* MS */
-DEFNAME	("INT8",	"int8",		"Int8",		genNONE,	specINT8)	/* GNU */
-DEFNAME	("IOR",		"ior",		"IOr",		genNONE,	specIOR)	/* F90,	VXT */
-DEFNAME	("IRAND",	"irand",	"IRand",	genNONE,	specIRAND)	/* UNIX */
-DEFNAME	("ISATTY",	"isatty",	"IsaTty",	genNONE,	specISATTY)	/* UNIX */
-DEFNAME	("ISHFT",	"ishft",	"IShft",	genNONE,	specISHFT)	/* F90 */
-DEFNAME	("ISHFTC",	"ishftc",	"IShftC",	genNONE,	specISHFTC)	/* F90,	VXT */
-DEFNAME	("ISIGN",	"isign",	"ISign",	genNONE,	specISIGN)
-DEFNAME	("ITIME",	"itime",	"ITime",	genNONE,	specITIME)	/* UNIX */
-DEFNAME	("IZEXT",	"izext",	"IZExt",	genNONE,	specIZEXT)	/* VXT */
-DEFNAME	("JIABS",	"jiabs",	"JIAbs",	genNONE,	specJIABS)	/* VXT */
-DEFNAME	("JIAND",	"jiand",	"JIAnd",	genNONE,	specJIAND)	/* VXT */
-DEFNAME	("JIBCLR",	"jibclr",	"JIBClr",	genNONE,	specJIBCLR)	/* VXT */
-DEFNAME	("JIBITS",	"jibits",	"JIBits",	genNONE,	specJIBITS)	/* VXT */
-DEFNAME	("JIBSET",	"jibset",	"JIBSet",	genNONE,	specJIBSET)	/* VXT */
-DEFNAME	("JIDIM",	"jidim",	"JIDiM",	genNONE,	specJIDIM)	/* VXT */
-DEFNAME	("JIDINT",	"jidint",	"JIDInt",	genNONE,	specJIDINT)	/* VXT */
-DEFNAME	("JIDNNT",	"jidnnt",	"JIDNnt",	genNONE,	specJIDNNT)	/* VXT */
-DEFNAME	("JIEOR",	"jieor",	"JIEOr",	genNONE,	specJIEOR)	/* VXT */
-DEFNAME	("JIFIX",	"jifix",	"JIFix",	genNONE,	specJIFIX)	/* VXT */
-DEFNAME	("JINT",	"jint",		"JInt",		genNONE,	specJINT)	/* VXT */
-DEFNAME	("JIOR",	"jior",		"JIOr",		genNONE,	specJIOR)	/* VXT */
-DEFNAME	("JIQINT",	"jiqint",	"JIQint",	genNONE,	specJIQINT)	/* VXT */
-DEFNAME	("JIQNNT",	"jiqnnt",	"JIQNnt",	genNONE,	specJIQNNT)	/* VXT */
-DEFNAME	("JISHFT",	"jishft",	"JIShft",	genNONE,	specJISHFT)	/* VXT */
-DEFNAME	("JISHFTC",	"jishftc",	"JIShftC",	genNONE,	specJISHFTC)	/* VXT */
-DEFNAME	("JISIGN",	"jisign",	"JISign",	genNONE,	specJISIGN)	/* VXT */
-DEFNAME	("JMAX0",	"jmax0",	"JMax0",	genNONE,	specJMAX0)	/* VXT */
-DEFNAME	("JMAX1",	"jmax1",	"JMax1",	genNONE,	specJMAX1)	/* VXT */
-DEFNAME	("JMIN0",	"jmin0",	"JMin0",	genNONE,	specJMIN0)	/* VXT */
-DEFNAME	("JMIN1",	"jmin1",	"JMin1",	genNONE,	specJMIN1)	/* VXT */
-DEFNAME	("JMOD",	"jmod",		"JMod",		genNONE,	specJMOD)	/* VXT */
-DEFNAME	("JNINT",	"jnint",	"JNInt",	genNONE,	specJNINT)	/* VXT */
-DEFNAME	("JNOT",	"jnot",		"JNot",		genNONE,	specJNOT)	/* VXT */
-DEFNAME	("JZEXT",	"jzext",	"JZExt",	genNONE,	specJZEXT)	/* VXT */
-DEFNAME	("KILL",	"kill",		"Kill",		genKILL,	specNONE)	/* UNIX */
-DEFNAME	("KIND",	"kind",		"Kind",		genNONE,	specKIND)	/* F90 */
-DEFNAME	("LBOUND",	"lbound",	"LBound",	genNONE,	specLBOUND)	/* F90 */
-DEFNAME	("LEN",		"len",		"Len",		genNONE,	specLEN)
-DEFNAME	("LEN_TRIM",	"len_trim",	"Len_Trim",	genNONE,	specLEN_TRIM)	/* F90 */
-DEFNAME	("LGE",		"lge",		"LGe",		genNONE,	specLGE)
-DEFNAME	("LGT",		"lgt",		"LGt",		genNONE,	specLGT)
-DEFNAME	("LINK",	"link",		"Link",		genLINK,	specNONE)	/* UNIX */
-DEFNAME	("LLE",		"lle",		"LLe",		genNONE,	specLLE)
-DEFNAME	("LLT",		"llt",		"LLt",		genNONE,	specLLT)
-DEFNAME	("LNBLNK",	"lnblnk",	"LnBlnk",	genNONE,	specLNBLNK)	/* UNIX */
-DEFNAME	("LOC",		"loc",		"Loc",		genNONE,	specLOC)	/* VXT */
-DEFNAME	("LOG",		"log",		"Log",		genNONE,	specLOG)
-DEFNAME	("LOG10",	"log10",	"Log10",	genNONE,	specLOG10)
-DEFNAME	("LOGICAL",	"logical",	"Logical",	genNONE,	specLOGICAL)	/* F90 */
-DEFNAME	("LONG",	"long",		"Long",		genNONE,	specLONG)	/* UNIX */
-DEFNAME	("LSHIFT",	"lshift",	"LShift",	genNONE,	specLSHIFT)	/* F2C */
-DEFNAME	("LSTAT",	"lstat",	"LStat",	genLSTAT,	specNONE)	/* UNIX */
-DEFNAME	("LTIME",	"ltime",	"LTime",	genNONE,	specLTIME)	/* UNIX */
-DEFNAME	("MATMUL",	"matmul",	"MatMul",	genNONE,	specMATMUL)	/* F90 */
-DEFNAME	("MAX",		"max",		"Max",		genNONE,	specMAX)
-DEFNAME	("MAX0",	"max0",		"Max0",		genNONE,	specMAX0)
-DEFNAME	("MAX1",	"max1",		"Max1",		genNONE,	specMAX1)
-DEFNAME	("MAXEXPONENT",	"maxexponent",	"MaxExponent",	genNONE,	specMAXEXPONENT)	/* F90 */
-DEFNAME	("MAXLOC",	"maxloc",	"MaxLoc",	genNONE,	specMAXLOC)	/* F90 */
-DEFNAME	("MAXVAL",	"maxval",	"MaxVal",	genNONE,	specMAXVAL)	/* F90 */
-DEFNAME	("MCLOCK",	"mclock",	"MClock",	genNONE,	specMCLOCK)	/* UNIX */
-DEFNAME	("MCLOCK8",	"mclock8",	"MClock8",	genNONE,	specMCLOCK8)	/* UNIX */
-DEFNAME	("MERGE",	"merge",	"Merge",	genNONE,	specMERGE)	/* F90 */
-DEFNAME	("MIN",		"min",		"Min",		genNONE,	specMIN)
-DEFNAME	("MIN0",	"min0",		"Min0",		genNONE,	specMIN0)
-DEFNAME	("MIN1",	"min1",		"Min1",		genNONE,	specMIN1)
-DEFNAME	("MINEXPONENT",	"minexponent",	"MinExponent",	genNONE,	specMINEXPONENT)	/* F90 */
-DEFNAME	("MINLOC",	"minloc",	"MinLoc",	genNONE,	specMINLOC)	/* F90 */
-DEFNAME	("MINVAL",	"minval",	"MinVal",	genNONE,	specMINVAL)	/* F90 */
-DEFNAME	("MOD",		"mod",		"Mod",		genNONE,	specMOD)
-DEFNAME	("MODULO",	"modulo",	"Modulo",	genNONE,	specMODULO)	/* F90 */
-DEFNAME	("MVBITS",	"mvbits",	"MvBits",	genNONE,	specMVBITS)	/* F90 */
-DEFNAME	("NEAREST",	"nearest",	"Nearest",	genNONE,	specNEAREST)	/* F90 */
-DEFNAME	("NINT",	"nint",		"NInt",		genNONE,	specNINT)
-DEFNAME	("NOT",		"not",		"Not",		genNONE,	specNOT)	/* F2C,	F90,	VXT */
-DEFNAME	("OR",		"or",		"Or",		genNONE,	specOR)	/* F2C */
-DEFNAME	("PACK",	"pack",		"Pack",		genNONE,	specPACK)	/* F90 */
-DEFNAME	("PERROR",	"perror",	"PError",	genNONE,	specPERROR)	/* UNIX */
-DEFNAME	("PRECISION",	"precision",	"Precision",	genNONE,	specPRECISION)	/* F90 */
-DEFNAME	("PRESENT",	"present",	"Present",	genNONE,	specPRESENT)	/* F90 */
-DEFNAME	("PRODUCT",	"product",	"Product",	genNONE,	specPRODUCT)	/* F90 */
-DEFNAME	("QABS",	"qabs",		"QAbs",		genNONE,	specQABS)	/* VXT */
-DEFNAME	("QACOS",	"qacos",	"QACos",	genNONE,	specQACOS)	/* VXT */
-DEFNAME	("QACOSD",	"qacosd",	"QACosD",	genNONE,	specQACOSD)	/* VXT */
-DEFNAME	("QASIN",	"qasin",	"QASin",	genNONE,	specQASIN)	/* VXT */
-DEFNAME	("QASIND",	"qasind",	"QASinD",	genNONE,	specQASIND)	/* VXT */
-DEFNAME	("QATAN",	"qatan",	"QATan",	genNONE,	specQATAN)	/* VXT */
-DEFNAME	("QATAN2",	"qatan2",	"QATan2",	genNONE,	specQATAN2)	/* VXT */
-DEFNAME	("QATAN2D",	"qatan2d",	"QATan2D",	genNONE,	specQATAN2D)	/* VXT */
-DEFNAME	("QATAND",	"qatand",	"QATanD",	genNONE,	specQATAND)	/* VXT */
-DEFNAME	("QCOS",	"qcos",		"QCos",		genNONE,	specQCOS)	/* VXT */
-DEFNAME	("QCOSD",	"qcosd",	"QCosD",	genNONE,	specQCOSD)	/* VXT */
-DEFNAME	("QCOSH",	"qcosh",	"QCosH",	genNONE,	specQCOSH)	/* VXT */
-DEFNAME	("QDIM",	"qdim",		"QDiM",		genNONE,	specQDIM)	/* VXT */
-DEFNAME	("QEXP",	"qexp",		"QExp",		genNONE,	specQEXP)	/* VXT */
-DEFNAME	("QEXT",	"qext",		"QExt",		genNONE,	specQEXT)	/* VXT */
-DEFNAME	("QEXTD",	"qextd",	"QExtD",	genNONE,	specQEXTD)	/* VXT */
-DEFNAME	("QFLOAT",	"qfloat",	"QFloat",	genNONE,	specQFLOAT)	/* VXT */
-DEFNAME	("QINT",	"qint",		"QInt",		genNONE,	specQINT)	/* VXT */
-DEFNAME	("QLOG",	"qlog",		"QLog",		genNONE,	specQLOG)	/* VXT */
-DEFNAME	("QLOG10",	"qlog10",	"QLog10",	genNONE,	specQLOG10)	/* VXT */
-DEFNAME	("QMAX1",	"qmax1",	"QMax1",	genNONE,	specQMAX1)	/* VXT */
-DEFNAME	("QMIN1",	"qmin1",	"QMin1",	genNONE,	specQMIN1)	/* VXT */
-DEFNAME	("QMOD",	"qmod",		"QMod",		genNONE,	specQMOD)	/* VXT */
-DEFNAME	("QNINT",	"qnint",	"QNInt",	genNONE,	specQNINT)	/* VXT */
-DEFNAME	("QSIN",	"qsin",		"QSin",		genNONE,	specQSIN)	/* VXT */
-DEFNAME	("QSIND",	"qsind",	"QSinD",	genNONE,	specQSIND)	/* VXT */
-DEFNAME	("QSINH",	"qsinh",	"QSinH",	genNONE,	specQSINH)	/* VXT */
-DEFNAME	("QSQRT",	"qsqrt",	"QSqRt",	genNONE,	specQSQRT)	/* VXT */
-DEFNAME	("QTAN",	"qtan",		"QTan",		genNONE,	specQTAN)	/* VXT */
-DEFNAME	("QTAND",	"qtand",	"QTanD",	genNONE,	specQTAND)	/* VXT */
-DEFNAME	("QTANH",	"qtanh",	"QTanH",	genNONE,	specQTANH)	/* VXT */
-DEFNAME	("RADIX",	"radix",	"Radix",	genNONE,	specRADIX)	/* F90 */
-DEFNAME	("RAND",	"rand",		"Rand",		genNONE,	specRAND)	/* UNIX */
-DEFNAME	("RANDOM_NUMBER",	"random_number",	"Random_Number",	genNONE,	specRANDOM_NUMBER)	/* F90 */
-DEFNAME	("RANDOM_SEED",	"random_seed",	"Random_Seed",	genNONE,	specRANDOM_SEED)	/* F90 */
-DEFNAME	("RANGE",	"range",	"Range",	genNONE,	specRANGE)	/* F90 */
-DEFNAME	("REAL",	"real",		"Real",		genNONE,	specREAL)
-DEFNAME	("REALPART",	"realpart",	"RealPart",	genNONE,	specREALPART)	/* GNU */
-DEFNAME	("RENAME",	"rename",	"Rename",	genRENAME,	specNONE)	/* UNIX */
-DEFNAME	("REPEAT",	"repeat",	"Repeat",	genNONE,	specREPEAT)	/* F90 */
-DEFNAME	("RESHAPE",	"reshape",	"Reshape",	genNONE,	specRESHAPE)	/* F90 */
-DEFNAME	("RRSPACING",	"rrspacing",	"RRSpacing",	genNONE,	specRRSPACING)	/* F90 */
-DEFNAME	("RSHIFT",	"rshift",	"RShift",	genNONE,	specRSHIFT)	/* F2C */
-DEFNAME	("SCALE",	"scale",	"Scale",	genNONE,	specSCALE)	/* F90 */
-DEFNAME	("SCAN",	"scan",		"Scan",		genNONE,	specSCAN)	/* F90 */
-DEFNAME	("SECNDS",	"secnds",	"Secnds",	genNONE,	specSECNDS)	/* VXT */
-DEFNAME	("SECOND",	"second",	"Second",	genSECOND,	specNONE)	/* UNIX */
-DEFNAME	("SELECTED_INT_KIND",	"selected_int_kind",	"Selected_Int_Kind",	genNONE,	specSEL_INT_KIND)	/* F90 */
-DEFNAME	("SELECTED_REAL_KIND",	"selected_real_kind",	"Selected_Real_Kind",	genNONE,	specSEL_REAL_KIND)	/* F90 */
-DEFNAME	("SET_EXPONENT",	"set_exponent",	"Set_Exponent",	genNONE,	specSET_EXPONENT)	/* F90 */
-DEFNAME	("SHAPE",	"shape",	"Shape",	genNONE,	specSHAPE)	/* F90 */
-DEFNAME	("SHORT",	"short",	"Short",	genNONE,	specSHORT)	/* UNIX */
-DEFNAME	("SIGN",	"sign",		"Sign",		genNONE,	specSIGN)
-DEFNAME	("SIGNAL",	"signal",	"Signal",	genSIGNAL,	specNONE)	/* UNIX */
-DEFNAME	("SIN",		"sin",		"Sin",		genNONE,	specSIN)
-DEFNAME	("SIND",	"sind",		"SinD",		genNONE,	specSIND)	/* VXT */
-DEFNAME	("SINH",	"sinh",		"SinH",		genNONE,	specSINH)
-DEFNAME	("SLEEP",	"sleep",	"Sleep",	genNONE,	specSLEEP)	/* UNIX */
-DEFNAME	("SNGL",	"sngl",		"Sngl",		genNONE,	specSNGL)
-DEFNAME	("SNGLQ",	"snglq",	"SnglQ",	genNONE,	specSNGLQ)	/* VXT */
-DEFNAME	("SPACING",	"spacing",	"Spacing",	genNONE,	specSPACING)	/* F90 */
-DEFNAME	("SPREAD",	"spread",	"Spread",	genNONE,	specSPREAD)	/* F90 */
-DEFNAME	("SQRT",	"sqrt",		"SqRt",		genNONE,	specSQRT)
-DEFNAME	("SRAND",	"srand",	"SRand",	genNONE,	specSRAND)	/* UNIX */
-DEFNAME	("STAT",	"stat",		"Stat",		genSTAT,	specNONE)	/* UNIX */
-DEFNAME	("SUM",		"sum",		"Sum",		genNONE,	specSUM)	/* F90 */
-DEFNAME	("SYMLNK",	"symlnk",	"SymLnk",	genSYMLNK,	specNONE)	/* UNIX */
-DEFNAME	("SYSTEM",	"system",	"System",	genSYSTEM,	specNONE)	/* UNIX */
-DEFNAME	("SYSTEM_CLOCK",	"system_clock",	"System_Clock",	genNONE,	specSYSTEM_CLOCK)	/* F90 */
-DEFNAME	("TAN",		"tan",		"Tan",		genNONE,	specTAN)
-DEFNAME	("TAND",	"tand",		"TanD",		genNONE,	specTAND)	/* VXT */
-DEFNAME	("TANH",	"tanh",		"TanH",		genNONE,	specTANH)
-DEFNAME	("TIME",	"time",		"Time",		genTIME,	specNONE)	/* UNIX, VXT */
-DEFNAME	("TIME8",	"time8",	"Time8",	genNONE,	specTIME8)	/* UNIX */
-DEFNAME	("TINY",	"tiny",		"Tiny",		genNONE,	specTINY)	/* F90 */
-DEFNAME	("TRANSFER",	"transfer",	"Transfer",	genNONE,	specTRANSFER)	/* F90 */
-DEFNAME	("TRANSPOSE",	"transpose",	"Transpose",	genNONE,	specTRANSPOSE)	/* F90 */
-DEFNAME	("TRIM",	"trim",		"Trim",		genNONE,	specTRIM)	/* F90 */
-DEFNAME	("TTYNAM",	"ttynam",	"TtyNam",	genTTYNAM,	specNONE)	/* UNIX */
-DEFNAME	("UBOUND",	"ubound",	"UBound",	genNONE,	specUBOUND)	/* F90 */
-DEFNAME	("UMASK",	"umask",	"UMask",	genUMASK,	specNONE)	/* UNIX */
-DEFNAME	("UNLINK",	"unlink",	"Unlink",	genUNLINK,	specNONE)	/* UNIX */
-DEFNAME	("UNPACK",	"unpack",	"Unpack",	genNONE,	specUNPACK)	/* F90 */
-DEFNAME	("VERIFY",	"verify",	"Verify",	genNONE,	specVERIFY)	/* F90 */
-DEFNAME	("XOR",		"xor",		"XOr",		genNONE,	specXOR)	/* F2C */
-DEFNAME	("ZABS",	"zabs",		"ZAbs",		genNONE,	specZABS)	/* F2C */
-DEFNAME	("ZCOS",	"zcos",		"ZCos",		genNONE,	specZCOS)	/* F2C */
-DEFNAME	("ZEXP",	"zexp",		"ZExp",		genNONE,	specZEXP)	/* F2C */
-DEFNAME	("ZEXT",	"zext",		"ZExt",		genNONE,	specZEXT)	/* VXT */
-DEFNAME	("ZLOG",	"zlog",		"ZLog",		genNONE,	specZLOG)	/* F2C */
-DEFNAME	("ZSIN",	"zsin",		"ZSin",		genNONE,	specZSIN)	/* F2C */
-DEFNAME	("ZSQRT",	"zsqrt",	"ZSqRt",	genNONE,	specZSQRT)	/* F2C */
-
-/* Internally generic intrinsics.
-
-   Should properly be called "mapped" intrinsics.  These are intrinsics
-   that map to one or more generally different implementations -- e.g.
-   that have differing interpretations depending on the Fortran dialect
-   being used.  Also, this includes the placeholder intrinsics that
-   have no specific versions, but we want to reserve the names for now.  */
-
-DEFGEN (CTIME, "CTIME",		/* UNIX */
-    FFEINTRIN_specCTIME_subr,
-    FFEINTRIN_specCTIME_func
-  )
-DEFGEN (CHDIR, "CHDIR", 	/* UNIX */
-    FFEINTRIN_specCHDIR_subr,
-    FFEINTRIN_specCHDIR_func
-  )
-DEFGEN (CHMOD, "CHMOD", 	/* UNIX */
-    FFEINTRIN_specCHMOD_subr,
-    FFEINTRIN_specCHMOD_func
-  )
-DEFGEN (DTIME, "DTIME", 	/* UNIX */
-    FFEINTRIN_specDTIME_subr,
-    FFEINTRIN_specDTIME_func
-  )
-DEFGEN (ETIME, "ETIME", 	/* UNIX */
-    FFEINTRIN_specETIME_subr,
-    FFEINTRIN_specETIME_func
-  )
-DEFGEN (FDATE, "FDATE", 	/* UNIX */
-    FFEINTRIN_specFDATE_subr,
-    FFEINTRIN_specFDATE_func
-  )
-DEFGEN (FGET, "FGET",	 	/* UNIX */
-    FFEINTRIN_specFGET_subr,
-    FFEINTRIN_specFGET_func
-  )
-DEFGEN (FGETC, "FGETC", 	/* UNIX */
-    FFEINTRIN_specFGETC_subr,
-    FFEINTRIN_specFGETC_func
-  )
-DEFGEN (FPABSP, "FPABSP",	/* F2C */
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-DEFGEN (FPEXPN, "FPEXPN",	/* F2C */
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-DEFGEN (FPFRAC, "FPFRAC",	/* F2C */
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-DEFGEN (FPMAKE, "FPMAKE",	/* F2C */
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-DEFGEN (FPRRSP, "FPRRSP",	/* F2C */
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-DEFGEN (FPSCAL, "FPSCAL",	/* F2C */
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-DEFGEN (FPUT, "FPUT",	 	/* UNIX */
-    FFEINTRIN_specFPUT_subr,
-    FFEINTRIN_specFPUT_func
-  )
-DEFGEN (FPUTC, "FPUTC", 	/* UNIX */
-    FFEINTRIN_specFPUTC_subr,
-    FFEINTRIN_specFPUTC_func
-  )
-DEFGEN (FSTAT, "FSTAT", 	/* UNIX */
-    FFEINTRIN_specFSTAT_subr,
-    FFEINTRIN_specFSTAT_func
-  )
-DEFGEN (FTELL, "FTELL", 	/* UNIX */
-    FFEINTRIN_specFTELL_subr,
-    FFEINTRIN_specFTELL_func
-  )
-DEFGEN (GETCWD, "GETCWD", 	/* UNIX */
-    FFEINTRIN_specGETCWD_subr,
-    FFEINTRIN_specGETCWD_func
-  )
-DEFGEN (HOSTNM, "HOSTNM", 	/* UNIX */
-    FFEINTRIN_specHOSTNM_subr,
-    FFEINTRIN_specHOSTNM_func
-  )
-DEFGEN (IDATE, "IDATE",		/* UNIX/VXT */
-    FFEINTRIN_specIDATE_unix,
-    FFEINTRIN_specIDATE_vxt
-  )
-DEFGEN (KILL, "KILL", 		/* UNIX */
-    FFEINTRIN_specKILL_subr,
-    FFEINTRIN_specKILL_func
-  )
-DEFGEN (LINK, "LINK", 		/* UNIX */
-    FFEINTRIN_specLINK_subr,
-    FFEINTRIN_specLINK_func
-  )
-DEFGEN (LSTAT, "LSTAT", 	/* UNIX */
-    FFEINTRIN_specLSTAT_subr,
-    FFEINTRIN_specLSTAT_func
-  )
-DEFGEN (RENAME, "RENAME", 	/* UNIX */
-    FFEINTRIN_specRENAME_subr,
-    FFEINTRIN_specRENAME_func
-  )
-DEFGEN (SECOND, "SECOND",	/* UNIX/CRAY */
-    FFEINTRIN_specSECOND_func,
-    FFEINTRIN_specSECOND_subr
-  )
-DEFGEN (SIGNAL, "SIGNAL", 	/* UNIX */
-    FFEINTRIN_specSIGNAL_subr,
-    FFEINTRIN_specSIGNAL_func
-  )
-DEFGEN (STAT, "STAT", 		/* UNIX */
-    FFEINTRIN_specSTAT_subr,
-    FFEINTRIN_specSTAT_func
-  )
-DEFGEN (SYMLNK, "SYMLNK", 	/* UNIX */
-    FFEINTRIN_specSYMLNK_subr,
-    FFEINTRIN_specSYMLNK_func
-  )
-DEFGEN (SYSTEM, "SYSTEM", 	/* UNIX */
-    FFEINTRIN_specSYSTEM_subr,
-    FFEINTRIN_specSYSTEM_func
-  )
-DEFGEN (TIME, "TIME",		/* UNIX/VXT */
-    FFEINTRIN_specTIME_unix,
-    FFEINTRIN_specTIME_vxt
-  )
-DEFGEN (TTYNAM, "TTYNAM",	/* UNIX/VXT */
-    FFEINTRIN_specTTYNAM_subr,
-    FFEINTRIN_specTTYNAM_func
-  )
-DEFGEN (UMASK, "UMASK", 	/* UNIX */
-    FFEINTRIN_specUMASK_subr,
-    FFEINTRIN_specUMASK_func
-  )
-DEFGEN (UNLINK, "UNLINK", 	/* UNIX */
-    FFEINTRIN_specUNLINK_subr,
-    FFEINTRIN_specUNLINK_func
-  )
-DEFGEN (NONE, "none",
-    FFEINTRIN_specNONE,
-    FFEINTRIN_specNONE
-  )
-
-/* Specific intrinsic information.
-
-   Currently this list starts with the list of F77-standard intrinsics
-   in alphabetical order, then continues with the list of all other
-   intrinsics.
-
-   The second boolean argument specifies whether the intrinsic is
-   allowed by the standard to be passed as an actual argument.  */
-
-DEFSPEC (ABS,
-    "ABS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impABS
-  )
-DEFSPEC (ACOS,
-    "ACOS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impACOS
-  )
-DEFSPEC (AIMAG,
-    "AIMAG",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAIMAG
-  )
-DEFSPEC (AINT,
-    "AINT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAINT
-  )
-DEFSPEC (ALOG,
-    "ALOG",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impALOG
-  )
-DEFSPEC (ALOG10,
-    "ALOG10",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impALOG10
-  )
-DEFSPEC (AMAX0,
-    "AMAX0",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAMAX0
-  )
-DEFSPEC (AMAX1,
-    "AMAX1",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAMAX1
-  )
-DEFSPEC (AMIN0,
-    "AMIN0",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAMIN0
-  )
-DEFSPEC (AMIN1,
-    "AMIN1",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAMIN1
-  )
-DEFSPEC (AMOD,
-    "AMOD",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impAMOD
-  )
-DEFSPEC (ANINT,
-    "ANINT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impANINT
-  )
-DEFSPEC (ASIN,
-    "ASIN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impASIN
-  )
-DEFSPEC (ATAN,
-    "ATAN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impATAN
-  )
-DEFSPEC (ATAN2,
-    "ATAN2",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impATAN2
-  )
-DEFSPEC (CABS,
-    "CABS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCABS
-  )
-DEFSPEC (CCOS,
-    "CCOS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCCOS
-  )
-DEFSPEC (CEXP,
-    "CEXP",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCEXP
-  )
-DEFSPEC (CHAR,
-    "CHAR",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCHAR
-  )
-DEFSPEC (CLOG,
-    "CLOG",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCLOG
-  )
-DEFSPEC (CMPLX,
-    "CMPLX",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCMPLX
-  )
-DEFSPEC (CONJG,
-    "CONJG",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCONJG
-  )
-DEFSPEC (COS,
-    "COS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCOS
-  )
-DEFSPEC (COSH,
-    "COSH",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCOSH
-  )
-DEFSPEC (CSIN,
-    "CSIN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCSIN
-  )
-DEFSPEC (CSQRT,
-    "CSQRT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impCSQRT
-  )
-DEFSPEC (DABS,
-    "DABS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDABS
-  )
-DEFSPEC (DACOS,
-    "DACOS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDACOS
-  )
-DEFSPEC (DASIN,
-    "DASIN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDASIN
-  )
-DEFSPEC (DATAN,
-    "DATAN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDATAN
-  )
-DEFSPEC (DATAN2,
-    "DATAN2",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDATAN2
-  )
-DEFSPEC (DBLE,
-    "DBLE",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDBLE
-  )
-DEFSPEC (DCOS,
-    "DCOS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDCOS
-  )
-DEFSPEC (DCOSH,
-    "DCOSH",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDCOSH
-  )
-DEFSPEC (DDIM,
-    "DDIM",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDDIM
-  )
-DEFSPEC (DEXP,
-    "DEXP",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDEXP
-  )
-DEFSPEC (DIM,
-    "DIM",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDIM
-  )
-DEFSPEC (DINT,
-    "DINT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDINT
-  )
-DEFSPEC (DLOG,
-    "DLOG",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDLOG
-  )
-DEFSPEC (DLOG10,
-    "DLOG10",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDLOG10
-  )
-DEFSPEC (DMAX1,
-    "DMAX1",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDMAX1
-  )
-DEFSPEC (DMIN1,
-    "DMIN1",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDMIN1
-  )
-DEFSPEC (DMOD,
-    "DMOD",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDMOD
-  )
-DEFSPEC (DNINT,
-    "DNINT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDNINT
-  )
-DEFSPEC (DPROD,
-    "DPROD",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDPROD
-  )
-DEFSPEC (DSIGN,
-    "DSIGN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDSIGN
-  )
-DEFSPEC (DSIN,
-    "DSIN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDSIN
-  )
-DEFSPEC (DSINH,
-    "DSINH",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDSINH
-  )
-DEFSPEC (DSQRT,
-    "DSQRT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDSQRT
-  )
-DEFSPEC (DTAN,
-    "DTAN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDTAN
-  )
-DEFSPEC (DTANH,
-    "DTANH",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impDTANH
-  )
-DEFSPEC (EXP,
-    "EXP",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impEXP
-  )
-DEFSPEC (FLOAT,
-    "FLOAT",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impFLOAT
-  )
-DEFSPEC (IABS,
-    "IABS",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impIABS
-  )
-DEFSPEC (ICHAR,
-    "ICHAR",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impICHAR
-  )
-DEFSPEC (IDIM,
-    "IDIM",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impIDIM
-  )
-DEFSPEC (IDINT,
-    "IDINT",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impIDINT
-  )
-DEFSPEC (IDNINT,
-    "IDNINT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impIDNINT
-  )
-DEFSPEC (IFIX,
-    "IFIX",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impIFIX
-  )
-DEFSPEC (INDEX,
-    "INDEX",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impINDEX
-  )
-DEFSPEC (INT,
-    "INT",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impINT
-  )
-DEFSPEC (ISIGN,
-    "ISIGN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impISIGN
-  )
-DEFSPEC (LEN,
-    "LEN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLEN
-  )
-DEFSPEC (LGE,
-    "LGE",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLGE
-  )
-DEFSPEC (LGT,
-    "LGT",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLGT
-  )
-DEFSPEC (LLE,
-    "LLE",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLLE
-  )
-DEFSPEC (LLT,
-    "LLT",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLLT
-  )
-DEFSPEC (LOG,
-    "LOG",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLOG
-  )
-DEFSPEC (LOG10,
-    "LOG10",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impLOG10
-  )
-DEFSPEC (MAX,
-    "MAX",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMAX
-  )
-DEFSPEC (MAX0,
-    "MAX0",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMAX0
-  )
-DEFSPEC (MAX1,
-    "MAX1",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMAX1
-  )
-DEFSPEC (MIN,
-    "MIN",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMIN
-  )
-DEFSPEC (MIN0,
-    "MIN0",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMIN0
-  )
-DEFSPEC (MIN1,
-    "MIN1",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMIN1
-  )
-DEFSPEC (MOD,
-    "MOD",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impMOD
-  )
-DEFSPEC (NINT,
-    "NINT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impNINT
-  )
-DEFSPEC (REAL,
-    "REAL",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impREAL
-  )
-DEFSPEC (SIGN,
-    "SIGN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impSIGN
-  )
-DEFSPEC (SIN,
-    "SIN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impSIN
-  )
-DEFSPEC (SINH,
-    "SINH",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impSINH
-  )
-DEFSPEC (SNGL,
-    "SNGL",
-    FALSE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impSNGL
-  )
-DEFSPEC (SQRT,
-    "SQRT",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impSQRT
-  )
-DEFSPEC (TAN,
-    "TAN",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impTAN
-  )
-DEFSPEC (TANH,
-    "TANH",
-    TRUE,
-    FFEINTRIN_familyF77,
-    FFEINTRIN_impTANH
-  )
-
-DEFSPEC (ABORT,
-    "ABORT",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impABORT
-  )
-DEFSPEC (ACCESS,
-    "ACCESS",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impACCESS
-)
-DEFSPEC (ACHAR,
-    "ACHAR",
-    FALSE,
-    FFEINTRIN_familyASC,
-    FFEINTRIN_impACHAR
-  )
-DEFSPEC (ACOSD,
-    "ACOSD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ADJUSTL,
-    "ADJUSTL",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ADJUSTR,
-    "ADJUSTR",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (AIMAX0,
-    "AIMAX0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (AIMIN0,
-    "AIMIN0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (AJMAX0,
-    "AJMAX0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (AJMIN0,
-    "AJMIN0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ALARM,
-    "ALARM",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impALARM
-  )
-DEFSPEC (ALL,
-    "ALL",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ALLOCATED,
-    "ALLOCATED",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (AND,
-    "AND",
-    FALSE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impAND
-  )
-DEFSPEC (ANY,
-    "ANY",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ASIND,
-    "ASIND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ASSOCIATED,
-    "ASSOCIATED",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ATAN2D,
-    "ATAN2D",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ATAND,
-    "ATAND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (BESJ0,
-    "BESJ0",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impBESJ0
-)
-DEFSPEC (BESJ1,
-    "BESJ1",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impBESJ1
-)
-DEFSPEC (BESJN,
-    "BESJN",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impBESJN
-)
-DEFSPEC (BESY0,
-    "BESY0",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impBESY0
-)
-DEFSPEC (BESY1,
-    "BESY1",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impBESY1
-)
-DEFSPEC (BESYN,
-    "BESYN",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impBESYN
-)
-DEFSPEC (BIT_SIZE,
-    "BIT_SIZE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impBIT_SIZE
-  )
-DEFSPEC (BITEST,
-    "BITEST",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (BJTEST,
-    "BJTEST",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (BTEST,
-    "BTEST",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impBTEST
-  )
-DEFSPEC (CDABS,
-    "CDABS",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impCDABS
-  )
-DEFSPEC (CDCOS,
-    "CDCOS",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impCDCOS
-  )
-DEFSPEC (CDEXP,
-    "CDEXP",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impCDEXP
-  )
-DEFSPEC (CDLOG,
-    "CDLOG",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impCDLOG
-  )
-DEFSPEC (CDSIN,
-    "CDSIN",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impCDSIN
-  )
-DEFSPEC (CDSQRT,
-    "CDSQRT",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impCDSQRT
-  )
-DEFSPEC (CEILING,
-    "CEILING",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (CHDIR_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impCHDIR_func
-)
-DEFSPEC (CHDIR_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impCHDIR_subr
-)
-DEFSPEC (CHMOD_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impCHMOD_func
-)
-DEFSPEC (CHMOD_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impCHMOD_subr
-)
-DEFSPEC (COMPLEX,
-    "COMPLEX",
-    FALSE,
-    FFEINTRIN_familyGNU,
-    FFEINTRIN_impCOMPLEX
-  )
-DEFSPEC (COSD,
-    "COSD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (COUNT,
-    "COUNT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (CSHIFT,
-    "CSHIFT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (CPU_TIME,
-    "CPU_TIME",
-    FALSE,
-    FFEINTRIN_familyF95,
-    FFEINTRIN_impCPU_TIME
-)
-DEFSPEC (CTIME_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impCTIME_func
-)
-DEFSPEC (CTIME_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impCTIME_subr
-)
-DEFSPEC (DACOSD,
-    "DACOSD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DASIND,
-    "DASIND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DATAN2D,
-    "DATAN2D",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DATAND,
-    "DATAND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DATE,
-    "DATE",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impDATE
-)
-DEFSPEC (DATE_AND_TIME,
-    "DATE_AND_TIME",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impDATE_AND_TIME
-  )
-DEFSPEC (DBESJ0,
-    "DBESJ0",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDBESJ0
-)
-DEFSPEC (DBESJ1,
-    "DBESJ1",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDBESJ1
-)
-DEFSPEC (DBESJN,
-    "DBESJN",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDBESJN
-)
-DEFSPEC (DBESY0,
-    "DBESY0",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDBESY0
-)
-DEFSPEC (DBESY1,
-    "DBESY1",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDBESY1
-)
-DEFSPEC (DBESYN,
-    "DBESYN",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDBESYN
-)
-DEFSPEC (DBLEQ,
-    "DBLEQ",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DCMPLX,
-    "DCMPLX",
-    FALSE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impDCMPLX
-  )
-DEFSPEC (DCONJG,
-    "DCONJG",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impDCONJG
-  )
-DEFSPEC (DCOSD,
-    "DCOSD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DERF,
-    "DERF",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDERF
-  )
-DEFSPEC (DERFC,
-    "DERFC",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDERFC
-  )
-DEFSPEC (DFLOAT,
-    "DFLOAT",
-    FALSE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impDFLOAT
-  )
-DEFSPEC (DFLOTI,
-    "DFLOTI",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DFLOTJ,
-    "DFLOTJ",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DIGITS,
-    "DIGITS",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DIMAG,
-    "DIMAG",
-    TRUE,
-    FFEINTRIN_familyFVZ,
-    FFEINTRIN_impDIMAG
-  )
-DEFSPEC (DOT_PRODUCT,
-    "DOT_PRODUCT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DREAL,
-    "DREAL",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impDREAL
-  )
-DEFSPEC (DSIND,
-    "DSIND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DTAND,
-    "DTAND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (DTIME_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impDTIME_func
-)
-DEFSPEC (DTIME_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impDTIME_subr
-)
-DEFSPEC (EOSHIFT,
-    "EOSHIFT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (EPSILON,
-    "EPSILON",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ERF,
-    "ERF",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impERF
-  )
-DEFSPEC (ERFC,
-    "ERFC",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impERFC
-  )
-DEFSPEC (ETIME_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impETIME_func
-)
-DEFSPEC (ETIME_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impETIME_subr
-)
-DEFSPEC (EXIT,
-    "EXIT",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impEXIT
-  )
-DEFSPEC (EXPONENT,
-    "EXPONENT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (FDATE_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFDATE_func
-)
-DEFSPEC (FDATE_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFDATE_subr
-)
-DEFSPEC (FGET_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impFGET_func
-)
-DEFSPEC (FGET_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFGET_subr
-)
-DEFSPEC (FGETC_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impFGETC_func
-)
-DEFSPEC (FGETC_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFGETC_subr
-)
-DEFSPEC (FLOATI,
-    "FLOATI",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (FLOATJ,
-    "FLOATJ",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (FLOOR,
-    "FLOOR",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (FLUSH,
-    "FLUSH",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFLUSH
-  )
-DEFSPEC (FNUM,
-    "FNUM",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFNUM
-)
-DEFSPEC (FPUT_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impFPUT_func
-)
-DEFSPEC (FPUT_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFPUT_subr
-)
-DEFSPEC (FPUTC_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impFPUTC_func
-)
-DEFSPEC (FPUTC_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFPUTC_subr
-)
-DEFSPEC (FRACTION,
-    "FRACTION",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (FSEEK,
-    "FSEEK",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFSEEK
-  )
-DEFSPEC (FSTAT_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFSTAT_func
-)
-DEFSPEC (FSTAT_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFSTAT_subr
-)
-DEFSPEC (FTELL_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFTELL_func
-  )
-DEFSPEC (FTELL_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impFTELL_subr
-  )
-DEFSPEC (GERROR,
-    "GERROR",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGERROR
-)
-DEFSPEC (GETARG,
-    "GETARG",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETARG
-  )
-DEFSPEC (GETCWD_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETCWD_func
-)
-DEFSPEC (GETCWD_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETCWD_subr
-)
-DEFSPEC (GETENV,
-    "GETENV",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETENV
-  )
-DEFSPEC (GETGID,
-    "GETGID",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETGID
-)
-DEFSPEC (GETLOG,
-    "GETLOG",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETLOG
-)
-DEFSPEC (GETPID,
-    "GETPID",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETPID
-)
-DEFSPEC (GETUID,
-    "GETUID",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGETUID
-)
-DEFSPEC (GMTIME,
-    "GMTIME",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impGMTIME
-)
-DEFSPEC (HOSTNM_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impHOSTNM_func
-)
-DEFSPEC (HOSTNM_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impHOSTNM_subr
-)
-DEFSPEC (HUGE,
-    "HUGE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IACHAR,
-    "IACHAR",
-    FALSE,
-    FFEINTRIN_familyASC,
-    FFEINTRIN_impIACHAR
-  )
-DEFSPEC (IAND,
-    "IAND",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impIAND
-  )
-DEFSPEC (IARGC,
-    "IARGC",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impIARGC
-  )
-DEFSPEC (IBCLR,
-    "IBCLR",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impIBCLR
-  )
-DEFSPEC (IBITS,
-    "IBITS",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impIBITS
-  )
-DEFSPEC (IBSET,
-    "IBSET",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impIBSET
-  )
-DEFSPEC (IDATE_unix,
-    "UNIX",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impIDATE_unix
-)
-DEFSPEC (IDATE_vxt,
-    "VXT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impIDATE_vxt
-)
-DEFSPEC (IEOR,
-    "IEOR",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impIEOR
-  )
-DEFSPEC (IERRNO,
-    "IERRNO",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impIERRNO
-)
-DEFSPEC (IIABS,
-    "IIABS",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIAND,
-    "IIAND",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIBCLR,
-    "IIBCLR",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIBITS,
-    "IIBITS",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIBSET,
-    "IIBSET",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIDIM,
-    "IIDIM",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIDINT,
-    "IIDINT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIDNNT,
-    "IIDNNT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIEOR,
-    "IIEOR",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIFIX,
-    "IIFIX",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IINT,
-    "IINT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIOR,
-    "IIOR",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIQINT,
-    "IIQINT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IIQNNT,
-    "IIQNNT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IISHFT,
-    "IISHFT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IISHFTC,
-    "IISHFTC",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IISIGN,
-    "IISIGN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IMAG,
-    "IMAG",
-    FALSE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impIMAGPART
-  )
-DEFSPEC (IMAGPART,
-    "IMAGPART",
-    FALSE,
-    FFEINTRIN_familyGNU,
-    FFEINTRIN_impIMAGPART
-  )
-DEFSPEC (IMAX0,
-    "IMAX0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IMAX1,
-    "IMAX1",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IMIN0,
-    "IMIN0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IMIN1,
-    "IMIN1",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (IMOD,
-    "IMOD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ININT,
-    "ININT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (INOT,
-    "INOT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (INT2,
-    "INT2",
-    FALSE,
-    FFEINTRIN_familyGNU,
-    FFEINTRIN_impINT2
-  )
-DEFSPEC (INT8,
-    "INT8",
-    FALSE,
-    FFEINTRIN_familyGNU,
-    FFEINTRIN_impINT8
-  )
-DEFSPEC (IOR,
-    "IOR",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impIOR
-  )
-DEFSPEC (IRAND,
-    "IRAND",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impIRAND
-)
-DEFSPEC (ISATTY,
-    "ISATTY",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impISATTY
-)
-DEFSPEC (ISHFT,
-    "ISHFT",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impISHFT
-  )
-DEFSPEC (ISHFTC,
-    "ISHFTC",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impISHFTC
-  )
-DEFSPEC (ITIME,
-    "ITIME",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impITIME
-)
-DEFSPEC (IZEXT,
-    "IZEXT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIABS,
-    "JIABS",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIAND,
-    "JIAND",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIBCLR,
-    "JIBCLR",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIBITS,
-    "JIBITS",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIBSET,
-    "JIBSET",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIDIM,
-    "JIDIM",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIDINT,
-    "JIDINT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIDNNT,
-    "JIDNNT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIEOR,
-    "JIEOR",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIFIX,
-    "JIFIX",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JINT,
-    "JINT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIOR,
-    "JIOR",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIQINT,
-    "JIQINT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JIQNNT,
-    "JIQNNT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JISHFT,
-    "JISHFT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JISHFTC,
-    "JISHFTC",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JISIGN,
-    "JISIGN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JMAX0,
-    "JMAX0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JMAX1,
-    "JMAX1",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JMIN0,
-    "JMIN0",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JMIN1,
-    "JMIN1",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JMOD,
-    "JMOD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JNINT,
-    "JNINT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JNOT,
-    "JNOT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (JZEXT,
-    "JZEXT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (KILL_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impKILL_func
-)
-DEFSPEC (KILL_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impKILL_subr
-)
-DEFSPEC (KIND,
-    "KIND",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (LBOUND,
-    "LBOUND",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (LINK_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impLINK_func
-)
-DEFSPEC (LINK_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLINK_subr
-)
-DEFSPEC (LEN_TRIM,
-    "LEN_TRIM",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impLNBLNK
-  )
-DEFSPEC (LNBLNK,
-    "LNBLNK",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLNBLNK
-)
-DEFSPEC (LOC,
-    "LOC",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLOC
-  )
-DEFSPEC (LOGICAL,
-    "LOGICAL",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (LONG,
-    "LONG",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLONG
-  )
-DEFSPEC (LSHIFT,
-    "LSHIFT",
-    FALSE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impLSHIFT
-  )
-DEFSPEC (LSTAT_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLSTAT_func
-)
-DEFSPEC (LSTAT_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLSTAT_subr
-)
-DEFSPEC (LTIME,
-    "LTIME",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impLTIME
-)
-DEFSPEC (MATMUL,
-    "MATMUL",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MAXEXPONENT,
-    "MAXEXPONENT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MAXLOC,
-    "MAXLOC",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MAXVAL,
-    "MAXVAL",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MCLOCK,
-    "MCLOCK",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impMCLOCK
-)
-DEFSPEC (MCLOCK8,
-    "MCLOCK8",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impMCLOCK8
-)
-DEFSPEC (MERGE,
-    "MERGE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MINEXPONENT,
-    "MINEXPONENT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MINLOC,
-    "MINLOC",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MINVAL,
-    "MINVAL",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MODULO,
-    "MODULO",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (MVBITS,
-    "MVBITS",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impMVBITS
-  )
-DEFSPEC (NEAREST,
-    "NEAREST",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (NOT,
-    "NOT",
-    FALSE,
-    FFEINTRIN_familyMIL,
-    FFEINTRIN_impNOT
-  )
-DEFSPEC (OR,
-    "OR",
-    FALSE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impOR
-  )
-DEFSPEC (PACK,
-    "PACK",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (PERROR,
-    "PERROR",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impPERROR
-)
-DEFSPEC (PRECISION,
-    "PRECISION",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (PRESENT,
-    "PRESENT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (PRODUCT,
-    "PRODUCT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QABS,
-    "QABS",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QACOS,
-    "QACOS",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QACOSD,
-    "QACOSD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QASIN,
-    "QASIN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QASIND,
-    "QASIND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QATAN,
-    "QATAN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QATAN2,
-    "QATAN2",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QATAN2D,
-    "QATAN2D",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QATAND,
-    "QATAND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QCOS,
-    "QCOS",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QCOSD,
-    "QCOSD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QCOSH,
-    "QCOSH",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QDIM,
-    "QDIM",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QEXP,
-    "QEXP",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QEXT,
-    "QEXT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QEXTD,
-    "QEXTD",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QFLOAT,
-    "QFLOAT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QINT,
-    "QINT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QLOG,
-    "QLOG",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QLOG10,
-    "QLOG10",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QMAX1,
-    "QMAX1",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QMIN1,
-    "QMIN1",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QMOD,
-    "QMOD",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QNINT,
-    "QNINT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QSIGN,
-    "QSIGN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QSIN,
-    "QSIN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QSIND,
-    "QSIND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QSINH,
-    "QSINH",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QSQRT,
-    "QSQRT",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QTAN,
-    "QTAN",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QTAND,
-    "QTAND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (QTANH,
-    "QTANH",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RADIX,
-    "RADIX",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RAND,
-    "RAND",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impRAND
-)
-DEFSPEC (RANDOM_NUMBER,
-    "RANDOM_NUMBER",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RANDOM_SEED,
-    "RANDOM_SEED",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RANGE,
-    "RANGE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (REALPART,
-    "REALPART",
-    FALSE,
-    FFEINTRIN_familyGNU,
-    FFEINTRIN_impREALPART
-  )
-DEFSPEC (RENAME_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impRENAME_func
-)
-DEFSPEC (RENAME_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impRENAME_subr
-)
-DEFSPEC (REPEAT,
-    "REPEAT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RESHAPE,
-    "RESHAPE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RRSPACING,
-    "RRSPACING",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (RSHIFT,
-    "RSHIFT",
-    FALSE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impRSHIFT
-  )
-DEFSPEC (SCALE,
-    "SCALE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SCAN,
-    "SCAN",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SECNDS,
-    "SECNDS",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impSECNDS
-)
-DEFSPEC (SECOND_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSECOND_func
-)
-DEFSPEC (SECOND_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSECOND_subr
-)
-DEFSPEC (SEL_INT_KIND,
-    "SEL_INT_KIND",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SEL_REAL_KIND,
-    "SEL_REAL_KIND",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SET_EXPONENT,
-    "SET_EXPONENT",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SHAPE,
-    "SHAPE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SHORT,
-    "SHORT",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSHORT
-  )
-DEFSPEC (SIGNAL_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impSIGNAL_func
-  )
-DEFSPEC (SIGNAL_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSIGNAL_subr
-  )
-DEFSPEC (SIND,
-    "SIND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SLEEP,
-    "SLEEP",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSLEEP
-)
-DEFSPEC (SNGLQ,
-    "SNGLQ",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SPACING,
-    "SPACING",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SPREAD,
-    "SPREAD",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SRAND,
-    "SRAND",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSRAND
-)
-DEFSPEC (STAT_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSTAT_func
-)
-DEFSPEC (STAT_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSTAT_subr
-)
-DEFSPEC (SUM,
-    "SUM",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (SYMLNK_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impSYMLNK_func
-)
-DEFSPEC (SYMLNK_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSYMLNK_subr
-)
-DEFSPEC (SYSTEM_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impSYSTEM_func
-  )
-DEFSPEC (SYSTEM_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impSYSTEM_subr
-  )
-DEFSPEC (SYSTEM_CLOCK,
-    "SYSTEM_CLOCK",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impSYSTEM_CLOCK
-  )
-DEFSPEC (TAND,
-    "TAND",
-    TRUE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (TIME8,
-    "UNIX",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impTIME8
-)
-DEFSPEC (TIME_unix,
-    "UNIX",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impTIME_unix
-)
-DEFSPEC (TIME_vxt,
-    "VXT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impTIME_vxt
-)
-DEFSPEC (TINY,
-    "TINY",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (TRANSFER,
-    "TRANSFER",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (TRANSPOSE,
-    "TRANSPOSE",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (TRIM,
-    "TRIM",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (TTYNAM_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impTTYNAM_func
-)
-DEFSPEC (TTYNAM_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impTTYNAM_subr
-)
-DEFSPEC (UBOUND,
-    "UBOUND",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (UMASK_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impUMASK_func
-)
-DEFSPEC (UMASK_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impUMASK_subr
-)
-DEFSPEC (UNLINK_func,
-    "function",
-    FALSE,
-    FFEINTRIN_familyBADU77,
-    FFEINTRIN_impUNLINK_func
-)
-DEFSPEC (UNLINK_subr,
-    "subroutine",
-    FALSE,
-    FFEINTRIN_familyF2U,
-    FFEINTRIN_impUNLINK_subr
-)
-DEFSPEC (UNPACK,
-    "UNPACK",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (VERIFY,
-    "VERIFY",
-    FALSE,
-    FFEINTRIN_familyF90,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (XOR,
-    "XOR",
-    FALSE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impXOR
-  )
-DEFSPEC (ZABS,
-    "ZABS",
-    TRUE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impCDABS
-  )
-DEFSPEC (ZCOS,
-    "ZCOS",
-    TRUE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impCDCOS
-  )
-DEFSPEC (ZEXP,
-    "ZEXP",
-    TRUE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impCDEXP
-  )
-DEFSPEC (ZEXT,
-    "ZEXT",
-    FALSE,
-    FFEINTRIN_familyVXT,
-    FFEINTRIN_impNONE
-  )
-DEFSPEC (ZLOG,
-    "ZLOG",
-    TRUE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impCDLOG
-  )
-DEFSPEC (ZSIN,
-    "ZSIN",
-    TRUE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impCDSIN
-  )
-DEFSPEC (ZSQRT,
-    "ZSQRT",
-    TRUE,
-    FFEINTRIN_familyF2C,
-    FFEINTRIN_impCDSQRT
-  )
-DEFSPEC (NONE,
-    "none",
-    FALSE,
-    FFEINTRIN_familyNONE,
-    FFEINTRIN_impNONE
-  )
-
-/* Intrinsic implementations ordered in two sections:
-   F77, then extensions; secondarily, alphabetical
-   ordering.  */
-
-/* The DEFIMP macro specifies the following fields for an intrinsic:
-
-   CODE	      -- The internal name for this intrinsic; `FFEINTRIN_imp'
-		 prepends this to form the `enum' name.
-
-   NAME       -- The textual name to use when printing information on
-		 this intrinsic.
-
-   GFRTDIRECT -- The run-time library routine that is suitable for
-		 a call to implement a *direct* invocation of the
-		 intrinsic (e.g. `ABS(10)').
-
-   GFRTF2C    -- The run-time library routine that is suitable for
-		 passing as an argument to a procedure that will
-		 invoke the argument as an EXTERNAL procedure, when
-		 f2c calling conventions will be used (e.g.
-		 `CALL FOO(ABS)', when FOO compiled with -ff2c).
-
-   GFRTGNU    -- The run-time library routine that is suitable for
-		 passing as an argument to a procedure that will
-		 invoke the argument as an EXTERNAL procedure, when
-		 GNU calling conventions will be used (e.g.
-		 `CALL FOO(ABS)', when FOO compiled with -fno-f2c).
-
-   CONTROL    -- A control string, described below.
-
-   The DEFIMPY macro specifies the above, plus:
-
-   Y2KBAD     -- TRUE if the intrinsic is known to be non-Y2K-compliant,
-                 FALSE if it is known to be Y2K-compliant.  (In terms of
-                 interface and libg2c implementation.)
-
-*/
-
-/* The control string has the following format:
-
-     <return-type>:<arglist-info>:[<argitem-info>,...]
-
-   <return-type> is:
-
-     <return-base-type><return-kind-type>[<return-modifier>]
-
-   <return-base-type> is:
-
-     -    Subroutine
-     A    Character
-     C    Complex
-     I    Integer
-     L    Logical
-     R    Real
-     B    Boolean (I or L), decided by co-operand list (COL)
-     F    Floating-point (C or R), decided by COL
-     N    Numeric (C, I, or R), decided by co-operand list (COL)
-     S    Scalar numeric (I or R), decided by COL, which may be COMPLEX
-
-   <return-kind-type> is:
-
-     -    Subroutine
-     =    Decided by COL
-     1    (Default)
-     2    (Twice the size of 1)
-     3    (Same size as CHARACTER*1)
-     4    (Twice the size of 2)
-     6    (Twice the size as 3)
-     7    (Same size as `char *')
-     C    Like 1 (F77), except (F90), if COL is COMPLEX, uses kind type of COL
-
-   <return-modifier> is:
-
-     *    Valid for <return-base-type> of `A' only, means program may
-          declare any length for return value, default being (*)
-
-   <arglist-info> is:
-
-     <COL-spec>
-
-   <COL-spec> is:
-
-     -    No COL (return-base-type and return-kind-type must be definitive)
-     *    All arguments form COL (must have more than one argument)
-     n    Argument n (0 for first arg, 1 for second, etc.) forms COL
-
-   <argitem-info> is:
-
-     <name>=[<optionality>]<arg-base-type><arg-kind-type>[<arg-len>][<arg-rank>][<arg-extra>]
-
-   <name> is the standard keyword name for the argument.
-
-   <optionality> is:
-
-     ?    Argument is optional
-     !    Like ?, but argument must be omitted if previous arg was COMPLEX
-     +    One or more of these arguments must be specified
-     *    Zero or more of these arguments must be specified
-     n    Numbered names for arguments, one or more must be specified
-     p    Like n, but two or more must be specified
-
-   <arg-base-type> is:
-
-     -    Any is valid (arg-kind-type is 0)
-     A    Character*(*)
-     C    Complex
-     I    Integer
-     L    Logical
-     R    Real
-     B    Boolean (I or L)
-     F    Floating-point (C or R)
-     N    Numeric (C, I, or R)
-     S    Scalar numeric (I or R)
-     g    GOTO label (alternate-return form of CALL) (arg-kind-type is 0)
-     s    Signal handler (INTEGER FUNCTION, SUBROUTINE or dummy/global
-          default INTEGER variable) (arg-kind-type is 0)
-
-   <arg-kind-type> is:
-
-     *    Any is valid
-     1    (Default)
-     2    (Twice the size of 1)
-     3    (Same size as CHARACTER*1)
-     4    (Twice the size of 2)
-     6    (Twice the size as 3)
-     A    Same as first argument
-     N    Not wider than the default kind
-
-   <arg-len> is:
-
-          (Default) CHARACTER*(*)
-     [n]  CHARACTER*n
-
-   <arg-rank> is:
-
-          (default) Rank-0 (variable or array element)
-     (n)  Rank-1 array n elements long
-     &    Any (arg-extra is &)
-
-   <arg-extra> is:
-
-          (default) Arg is INTENT(IN)
-     i    Arg's attributes are all that matter (inquiry function)
-     w    Arg is INTENT(OUT)
-     x    Arg is INTENT(INOUT)
-     &    Arg can have its address taken (LOC(), for example)
-
-*/
-
-DEFIMP	(ABS,		"ABS",		,ABS,,		"S=:0:A=N*")
-DEFIMP	(ACOS,		"ACOS",		L_ACOS,ACOS,,	"R=:0:X=R*")
-DEFIMP	(AIMAG,		"AIMAG",	,AIMAG,,	"RC:0:Z=C*")
-DEFIMP	(AINT,		"AINT",		,AINT,,		"R=:0:A=R*")
-DEFIMP	(ALOG,		"ALOG",		L_LOG,ALOG,,	"R1:-:X=R1")
-DEFIMP	(ALOG10,	"ALOG10",	L_LOG10,ALOG10,,"R1:-:X=R1")
-DEFIMP	(AMAX0,		"AMAX0",	,,,		"R1:*:A=pI1")
-DEFIMP	(AMAX1,		"AMAX1",	,,,		"R1:*:A=pR1")
-DEFIMP	(AMIN0,		"AMIN0",	,,,		"R1:*:A=pI1")
-DEFIMP	(AMIN1,		"AMIN1",	,,,		"R1:*:A=pR1")
-DEFIMP	(AMOD,		"AMOD",		L_FMOD,AMOD,,	"R1:*:A=R1,P=R1")
-DEFIMP	(ANINT,		"ANINT",	,ANINT,,	"R=:0:A=R*")
-DEFIMP	(ASIN,		"ASIN",		L_ASIN,ASIN,,	"R=:0:X=R*")
-DEFIMP	(ATAN,		"ATAN",		L_ATAN,ATAN,,	"R=:0:X=R*")
-DEFIMP	(ATAN2,		"ATAN2",	L_ATAN2,ATAN2,,	"R=:*:Y=R*,X=R*")
-DEFIMP	(CABS,		"CABS",		,CABS,,		"R1:-:A=C1")
-DEFIMP	(CCOS,		"CCOS",		,CCOS,,		"C1:-:X=C1")
-DEFIMP	(CEXP,		"CEXP",		,CEXP,,		"C1:-:X=C1")
-DEFIMP	(CHAR,		"CHAR",		,,,		"A1:-:I=I*")
-DEFIMP	(CLOG,		"CLOG",		,CLOG,,		"C1:-:X=C1")
-DEFIMP	(CMPLX,		"CMPLX",	,,,		"C1:*:X=N*,Y=!S*")
-DEFIMP	(CONJG,		"CONJG",	,CONJG,,	"C=:0:Z=C*")
-DEFIMP	(COS,		"COS",		L_COS,COS,,	"F=:0:X=F*")
-DEFIMP	(COSH,		"COSH",		L_COSH,COSH,,	"R=:0:X=R*")
-DEFIMP	(CSIN,		"CSIN",		,CSIN,,		"C1:-:X=C1")
-DEFIMP	(CSQRT,		"CSQRT",	,CSQRT,,	"C1:-:X=C1")
-DEFIMP	(DABS,		"DABS",		,DABS,,		"R2:-:A=R2")
-DEFIMP	(DACOS,		"DACOS",	L_ACOS,DACOS,,	"R2:-:X=R2")
-DEFIMP	(DASIN,		"DASIN",	L_ASIN,DASIN,,	"R2:-:X=R2")
-DEFIMP	(DATAN,		"DATAN",	L_ATAN,DATAN,,	"R2:-:X=R2")
-DEFIMP	(DATAN2,	"DATAN2",	L_ATAN2,DATAN2,,"R2:*:Y=R2,X=R2")
-DEFIMP	(DBLE,		"DBLE",		,,,		"R2:-:A=N*")
-DEFIMP	(DCMPLX,	"DCMPLX",	,,,		"C2:*:X=N*,Y=!S*")
-DEFIMP	(DCOS,		"DCOS",		L_COS,DCOS,,	"R2:-:X=R2")
-DEFIMP	(DCOSH,		"DCOSH",	L_COSH,DCOSH,,	"R2:-:X=R2")
-DEFIMP	(DDIM,		"DDIM",		,DDIM,,		"R2:*:X=R2,Y=R2")
-DEFIMP	(DEXP,		"DEXP",		L_EXP,DEXP,,	"R2:-:X=R2")
-DEFIMP	(DIM,		"DIM",		,DIM,,		"S=:*:X=S*,Y=S*")
-DEFIMP	(DINT,		"DINT",		,DINT,,		"R2:-:A=R2")
-DEFIMP	(DLOG,		"DLOG",		L_LOG,DLOG,,	"R2:-:X=R2")
-DEFIMP	(DLOG10,	"DLOG10",	L_LOG10,DLOG10,,"R2:-:X=R2")
-DEFIMP	(DMAX1,		"DMAX1",	,,,		"R2:*:A=pR2")
-DEFIMP	(DMIN1,		"DMIN1",	,,,		"R2:*:A=pR2")
-DEFIMP	(DMOD,		"DMOD",		L_FMOD,DMOD,,	"R2:*:A=R2,P=R2")
-DEFIMP	(DNINT,		"DNINT",	,DNINT,,	"R2:-:A=R2")
-DEFIMP	(DPROD,		"DPROD",	,DPROD,,	"R2:*:X=R1,Y=R1")
-DEFIMP	(DSIGN,		"DSIGN",	,DSIGN,,	"R2:*:A=R2,B=R2")
-DEFIMP	(DSIN,		"DSIN",		L_SIN,DSIN,,	"R2:-:X=R2")
-DEFIMP	(DSINH,		"DSINH",	L_SINH,DSINH,,	"R2:-:X=R2")
-DEFIMP	(DSQRT,		"DSQRT",	L_SQRT,DSQRT,,	"R2:-:X=R2")
-DEFIMP	(DTAN,		"DTAN",		L_TAN,DTAN,,	"R2:-:X=R2")
-DEFIMP	(DTANH,		"DTANH",	L_TANH,DTANH,,	"R2:-:X=R2")
-DEFIMP	(EXP,		"EXP",		L_EXP,EXP,,	"F=:0:X=F*")
-DEFIMP	(FLOAT,		"FLOAT",	,,,		"R1:-:A=I*")
-DEFIMP	(IABS,		"IABS",		,IABS,IABS,	"I1:-:A=I1")
-DEFIMP	(ICHAR,		"ICHAR",	,,,		"I1:-:C=A*")
-DEFIMP	(IDIM,		"IDIM",		,IDIM,IDIM,	"I1:*:X=I1,Y=I1")
-DEFIMP	(IDINT,		"IDINT",	,,,		"I1:-:A=R2")
-DEFIMP	(IDNINT,	"IDNINT",	,IDNINT,IDNINT,	"I1:-:A=R2")
-DEFIMP	(IFIX,		"IFIX",		,,,		"I1:-:A=R1")
-DEFIMP	(INDEX,		"INDEX",	,INDEX,INDEX,	"I1:*:String=A*,Substring=A*")
-DEFIMP	(INT,		"INT",		,,,		"I1:-:A=N*")
-DEFIMP	(ISIGN,		"ISIGN",	,ISIGN,ISIGN,	"I1:*:A=I1,B=I1")
-DEFIMP	(LEN,		"LEN",		,LEN,LEN,	"I1:-:String=A*i")
-DEFIMP	(LGE,		"LGE",		,LGE,LGE,	"L1:*:String_A=A1,String_B=A1")
-DEFIMP	(LGT,		"LGT",		,LGT,LGT,	"L1:*:String_A=A1,String_B=A1")
-DEFIMP	(LLE,		"LLE",		,LLE,LLE,	"L1:*:String_A=A1,String_B=A1")
-DEFIMP	(LLT,		"LLT",		,LLT,LLT,	"L1:*:String_A=A1,String_B=A1")
-DEFIMP	(LOG,		"LOG",		L_LOG,ALOG,,	"F=:0:X=F*")
-DEFIMP	(LOG10,		"LOG10",	L_LOG10,ALOG10,,"R=:0:X=R*")
-DEFIMP	(MAX,		"MAX",		,,,		"S=:*:A=pS*")
-DEFIMP	(MIN,		"MIN",		,,,		"S=:*:A=pS*")
-DEFIMP	(MAX0,		"MAX0",		,,,		"I1:*:A=pI1")
-DEFIMP	(MAX1,		"MAX1",		,,,		"I1:*:A=pR1")
-DEFIMP	(MIN0,		"MIN0",		,,,		"I1:*:A=pI1")
-DEFIMP	(MIN1,		"MIN1",		,,,		"I1:*:A=pR1")
-DEFIMP	(MOD,		"MOD",		,MOD,MOD,	"S=:*:A=S*,P=S*")
-DEFIMP	(NINT,		"NINT",		,NINT,NINT,	"I1:-:A=R*")
-DEFIMP	(REAL,		"REAL",		,,,		"RC:0:A=N*")
-DEFIMP	(SIGN,		"SIGN",		,SIGN,,		"S=:*:A=S*,B=S*")
-DEFIMP	(SIN,		"SIN",		L_SIN,SIN,,	"F=:0:X=F*")
-DEFIMP	(SINH,		"SINH",		L_SINH,SINH,,	"R=:0:X=R*")
-DEFIMP	(SNGL,		"SNGL",		,,,		"R1:-:A=R2")
-DEFIMP	(SQRT,		"SQRT",		L_SQRT,SQRT,,	"F=:0:X=F*")
-DEFIMP	(TAN,		"TAN",		L_TAN,TAN,,	"R=:0:X=R*")
-DEFIMP	(TANH,		"TANH",		L_TANH,TANH,,	"R=:0:X=R*")
-
-DEFIMP	(ABORT,		"ABORT",	ABORT,,,	"--:-:")
-DEFIMP	(ACCESS,	"ACCESS",	ACCESS,,,	"I1:-:Name=A1,Mode=A1")
-DEFIMP	(ACHAR,		"ACHAR",	,,,		"A1:-:I=I*")
-DEFIMP	(ALARM,		"ALARM",	ALARM,,,	"--:-:Seconds=I*,Handler=s*,Status=?I1w")
-DEFIMP	(AND,		"AND",		,,,		"B=:*:I=B*,J=B*")
-DEFIMP	(BESJ0,		"BESJ0",	L_BESJ0,,,	"R=:0:X=R*")
-DEFIMP	(BESJ1,		"BESJ1",	L_BESJ1,,,	"R=:0:X=R*")
-DEFIMP	(BESJN,		"BESJN",	L_BESJN,,,	"R=:1:N=IN,X=R*")
-DEFIMP	(BESY0,		"BESY0",	L_BESY0,,,	"R=:0:X=R*")
-DEFIMP	(BESY1,		"BESY1",	L_BESY1,,,	"R=:0:X=R*")
-DEFIMP	(BESYN,		"BESYN",	L_BESYN,,,	"R=:1:N=IN,X=R*")
-DEFIMP	(BIT_SIZE,	"BIT_SIZE",	,,,		"I=:0:I=I*i")
-DEFIMP	(BTEST,		"BTEST",	,,,		"L1:*:I=I*,Pos=I*")
-DEFIMP	(CDABS,		"CDABS",	,CDABS,,	"R2:-:A=C2")
-DEFIMP	(CDCOS,		"CDCOS",	,CDCOS,,	"C2:-:X=C2")
-DEFIMP	(CDEXP,		"CDEXP",	,CDEXP,,	"C2:-:X=C2")
-DEFIMP	(CDLOG,		"CDLOG",	,CDLOG,,	"C2:-:X=C2")
-DEFIMP	(CDSIN,		"CDSIN",	,CDSIN,,	"C2:-:X=C2")
-DEFIMP	(CDSQRT,	"CDSQRT",	,CDSQRT,,	"C2:-:X=C2")
-DEFIMP	(CHDIR_func,	"CHDIR_func",	CHDIR,,,	"I1:-:Dir=A1")
-DEFIMP	(CHDIR_subr,	"CHDIR_subr",	CHDIR,,,	"--:-:Dir=A1,Status=?I1w")
-DEFIMP	(CHMOD_func,	"CHMOD_func",	CHMOD,,,	"I1:-:Name=A1,Mode=A1")
-DEFIMP	(CHMOD_subr,	"CHMOD_subr",	CHMOD,,,	"--:-:Name=A1,Mode=A1,Status=?I1w")
-DEFIMP	(COMPLEX,	"COMPLEX",	,,,		"C=:*:Real=S*,Imag=S*")
-DEFIMP	(CPU_TIME,	"CPU_TIME",	SECOND,,,	"--:-:Seconds=R*w")
-DEFIMP	(CTIME_func,	"CTIME_func",	CTIME,,,	"A1*:-:STime=I*")
-DEFIMP	(CTIME_subr,	"CTIME_subr",	CTIME,,,	"--:-:STime=I*,Result=A1w")
-DEFIMPY	(DATE,		"DATE",		DATE,,,		"--:-:Date=A1w",	TRUE)
-DEFIMP	(DATE_AND_TIME,	"DATE_AND_TIME", DATE_AND_TIME,,, "--:-:Date=A1w,Time=?A1w,Zone=?A1w,Values=?I1(8)w")
-DEFIMP	(DBESJ0,	"DBESJ0",	L_BESJ0,,,	"R2:-:X=R2")
-DEFIMP	(DBESJ1,	"DBESJ1",	L_BESJ1,,,	"R2:-:X=R2")
-DEFIMP	(DBESJN,	"DBESJN",	L_BESJN,,,	"R2:-:N=IN,X=R2")
-DEFIMP	(DBESY0,	"DBESY0",	L_BESY0,,,	"R2:-:X=R2")
-DEFIMP	(DBESY1,	"DBESY1",	L_BESY1,,,	"R2:-:X=R2")
-DEFIMP	(DBESYN,	"DBESYN",	L_BESYN,,,	"R2:-:N=IN,X=R2")
-DEFIMP	(DCONJG,	"DCONJG",	,DCONJG,,	"C2:-:Z=C2")
-DEFIMP	(DERF,		"DERF",		L_ERF,DERF,,	"R2:-:X=R2")
-DEFIMP	(DERFC,		"DERFC",	L_ERFC,DERFC,,	"R2:-:X=R2")
-DEFIMP	(DFLOAT,	"DFLOAT",	,,,		"R2:-:A=I*")
-DEFIMP	(DIMAG,		"DIMAG",	,DIMAG,,	"R2:-:Z=C2")
-DEFIMP	(DREAL,		"DREAL",	,,,		"R2:-:A=N*")
-DEFIMP	(DTIME_func,	"DTIME_func",	DTIME,,,	"R1:-:TArray=R1(2)w")
-DEFIMP	(DTIME_subr,	"DTIME_subr",	DTIME,,,	"--:-:TArray=R1(2)w,Result=R1w")
-DEFIMP	(ERF,		"ERF",		L_ERF,ERF,,	"R=:0:X=R*")
-DEFIMP	(ERFC,		"ERFC",		L_ERFC,ERFC,,	"R=:0:X=R*")
-DEFIMP	(ETIME_func,	"ETIME_func",	ETIME,,,	"R1:-:TArray=R1(2)w")
-DEFIMP	(ETIME_subr,	"ETIME_subr",	ETIME,,,	"--:-:TArray=R1(2)w,Result=R1w")
-DEFIMP	(EXIT,		"EXIT",		EXIT,,,		"--:-:Status=?IN")
-DEFIMP	(FDATE_func,	"FDATE_func",	FDATE,,,	"A1*:-:")
-DEFIMP	(FDATE_subr,	"FDATE_subr",	FDATE,,,	"--:-:Date=A1w")
-DEFIMP	(FGET_func,	"FGET_func",	FGET,,,		"I1:-:C=A1w")
-DEFIMP	(FGET_subr,	"FGET_subr",	FGET,,,		"--:-:C=A1w,Status=?I1w")
-DEFIMP	(FGETC_func,	"FGETC_func",	FGETC,,,	"I1:-:Unit=I*,C=A1w")
-DEFIMP	(FGETC_subr,	"FGETC_subr",	FGETC,,,	"--:-:Unit=I*,C=A1w,Status=?I1w")
-DEFIMP	(FLUSH,		"FLUSH",	,,,		"--:-:Unit=?I*")
-DEFIMP	(FNUM,		"FNUM",		FNUM,,,		"I1:-:Unit=I*")
-DEFIMP	(FPUT_func,	"FPUT_func",	FPUT,,,		"I1:-:C=A1")
-DEFIMP	(FPUT_subr,	"FPUT_subr",	FPUT,,,		"--:-:C=A1,Status=?I1w")
-DEFIMP	(FPUTC_func,	"FPUTC_func",	FPUTC,,,	"I1:-:Unit=I*,C=A1")
-DEFIMP	(FPUTC_subr,	"FPUTC_subr",	FPUTC,,,	"--:-:Unit=I*,C=A1,Status=?I1w")
-DEFIMP	(FSEEK,		"FSEEK",	FSEEK,,,	"--:-:Unit=I*,Offset=I*,Whence=I*,ErrLab=?g*")
-DEFIMP	(FSTAT_func,	"FSTAT_func",	FSTAT,,,	"I1:-:Unit=I*,SArray=I1(13)w")
-DEFIMP	(FSTAT_subr,	"FSTAT_subr",	FSTAT,,,	"--:-:Unit=I*,SArray=I1(13)w,Status=?I1w")
-DEFIMP	(FTELL_func,	"FTELL_func",	FTELL,,,	"I1:-:Unit=I*")
-DEFIMP	(FTELL_subr,	"FTELL_subr",	FTELL,,,	"--:-:Unit=I*,Offset=I1w")
-DEFIMP	(GERROR,	"GERROR",	GERROR,,,	"--:-:Message=A1w")
-DEFIMP	(GETARG,	"GETARG",	GETARG,,,	"--:-:Pos=IN,Value=A1w")
-DEFIMP	(GETCWD_func,	"GETCWD_func",	GETCWD,,,	"I1:-:Name=A1w")
-DEFIMP	(GETCWD_subr,	"GETCWD_subr",	GETCWD,,,	"--:-:Name=A1w,Status=?I1w")
-DEFIMP	(GETGID,	"GETGID",	GETGID,,,	"I1:-:")
-DEFIMP	(GETLOG,	"GETLOG",	GETLOG,,,	"--:-:Login=A1w")
-DEFIMP	(GETPID,	"GETPID",	GETPID,,,	"I1:-:")
-DEFIMP	(GETUID,	"GETUID",	GETUID,,,	"I1:-:")
-DEFIMP	(GETENV,	"GETENV",	GETENV,,,	"--:-:Name=A1,Value=A1w")
-DEFIMP	(GMTIME,	"GMTIME",	GMTIME,,,	"--:-:STime=I1,TArray=I1(9)w")
-DEFIMP	(HOSTNM_func,	"HOSTNM_func",	HOSTNM,,,	"I1:-:Name=A1w")
-DEFIMP	(HOSTNM_subr,	"HOSTNM_subr",	HOSTNM,,,	"--:-:Name=A1w,Status=?I1w")
-DEFIMP	(IACHAR,	"IACHAR",	,,,		"I1:-:C=A*")
-DEFIMP	(IAND,		"IAND",		,,,		"I=:*:I=I*,J=I*")
-DEFIMP	(IARGC,		"IARGC",	IARGC,,,	"I1:-:")
-DEFIMP	(IBCLR,		"IBCLR",	,,,		"I=:0:I=I*,Pos=I*")
-DEFIMP	(IBITS,		"IBITS",	,,,		"I=:0:I=I*,Pos=I*,Len=I*")
-DEFIMP	(IBSET,		"IBSET",	,,,		"I=:0:I=I*,Pos=I*")
-DEFIMP	(IDATE_unix,	"IDATE_unix",	IDATE,,,	"--:-:TArray=I1(3)w")
-DEFIMPY	(IDATE_vxt,	"IDATE_vxt",	VXTIDATE,,,	"--:-:M=I1w,D=I1w,Y=I1w",	TRUE)
-DEFIMP	(IEOR,		"IEOR",		,,,		"I=:*:I=I*,J=I*")
-DEFIMP	(IOR,		"IOR",		,,,		"I=:*:I=I*,J=I*")
-DEFIMP	(IERRNO,	"IERRNO",	IERRNO,,,	"I1:-:")
-DEFIMP	(IMAGPART,	"IMAGPART",	,,,		"R=:0:Z=C*")
-DEFIMP	(INT2,		"INT2",		,,,		"I6:-:A=N*")
-DEFIMP	(INT8,		"INT8",		,,,		"I2:-:A=N*")
-DEFIMP	(IRAND,		"IRAND",	IRAND,,,	"I1:-:Flag=?I*")
-DEFIMP	(ISATTY,	"ISATTY",	ISATTY,,,	"L1:-:Unit=I*")
-DEFIMP	(ISHFT,		"ISHFT",	,,,		"I=:0:I=I*,Shift=I*")
-DEFIMP	(ISHFTC,	"ISHFTC",	,,,		"I=:0:I=I*,Shift=I*,Size=I*")
-DEFIMP	(ITIME,		"ITIME",	ITIME,,,	"--:-:TArray=I1(3)w")
-DEFIMP	(KILL_func,	"KILL_func",	KILL,,,		"I1:-:Pid=I*,Signal=I*")
-DEFIMP	(KILL_subr,	"KILL_subr",	KILL,,,		"--:-:Pid=I*,Signal=I*,Status=?I1w")
-DEFIMP	(LINK_func,	"LINK_func",	LINK,,,		"I1:-:Path1=A1,Path2=A1")
-DEFIMP	(LINK_subr,	"LINK_subr",	LINK,,,		"--:-:Path1=A1,Path2=A1,Status=?I1w")
-DEFIMP	(LNBLNK,	"LNBLNK",	LNBLNK,,,	"I1:-:String=A1")
-DEFIMP	(LONG,		"LONG",		,,,		"I1:-:A=I6")
-DEFIMP	(LSTAT_func,	"LSTAT_func",	LSTAT,,,	"I1:-:File=A1,SArray=I1(13)w")
-DEFIMP	(LSTAT_subr,	"LSTAT_subr",	LSTAT,,,	"--:-:File=A1,SArray=I1(13)w,Status=?I1w")
-DEFIMP	(LTIME,		"LTIME",	LTIME,,,	"--:-:STime=I1,TArray=I1(9)w")
-DEFIMP	(LOC,		"LOC",		,,,		"I7:-:Entity=-*&&")
-DEFIMP	(LSHIFT,	"LSHIFT",	,,,		"I=:0:I=I*,Shift=I*")
-DEFIMP	(MCLOCK,	"MCLOCK",	MCLOCK,,,	"I1:-:")
-DEFIMP	(MCLOCK8,	"MCLOCK8",	MCLOCK,,,	"I2:-:")
-DEFIMP	(MVBITS,	"MVBITS",	,,,		"--:-:From=I*,FromPos=I*,Len=I*,TO=IAx,ToPos=I*")
-DEFIMP	(NOT,		"NOT",		,,,		"I=:0:I=I*")
-DEFIMP	(OR,		"OR",		,,,		"B=:*:I=B*,J=B*")
-DEFIMP	(PERROR,	"PERROR",	PERROR,,,	"--:-:String=A1")
-DEFIMP	(RAND,		"RAND",		RAND,,,		"R1:-:Flag=?I*")
-DEFIMP	(REALPART,	"REALPART",	,,,		"R=:0:Z=C*")
-DEFIMP	(RENAME_func,	"RENAME_func",	RENAME,,,	"I1:-:Path1=A1,Path2=A1")
-DEFIMP	(RENAME_subr,	"RENAME_subr",	RENAME,,,	"--:-:Path1=A1,Path2=A1,Status=?I1w")
-DEFIMP	(RSHIFT,	"RSHIFT",	,,,		"I=:0:I=I*,Shift=I*")
-DEFIMP	(SECNDS,	"SECNDS",	SECNDS,,,	"R1:-:T=R1")
-DEFIMP	(SECOND_func,	"SECOND_func",	SECOND,SECOND,,	"R1:-:")
-DEFIMP	(SECOND_subr,	"SECOND_subr",	SECOND,,,	"--:-:Seconds=R*w")
-DEFIMP	(SHORT,		"SHORT",	,,,		"I6:-:A=I*")
-DEFIMP	(SIGNAL_func,	"SIGNAL_func",	L_SIGNAL,,,	"I7:-:Number=I*,Handler=s*")
-DEFIMP	(SIGNAL_subr,	"SIGNAL_subr",	L_SIGNAL,,,	"--:-:Number=I*,Handler=s*,Status=?I7w")
-DEFIMP	(SLEEP,		"SLEEP",	SLEEP,,,	"--:-:Seconds=I1")
-DEFIMP	(SRAND,		"SRAND",	SRAND,,,	"--:-:Seed=I*")
-DEFIMP	(STAT_func,	"STAT_func",	STAT,,,		"I1:-:File=A1,SArray=I1(13)w")
-DEFIMP	(STAT_subr,	"STAT_subr",	STAT,,,		"--:-:File=A1,SArray=I1(13)w,Status=?I1w")
-DEFIMP	(SYMLNK_func,	"SYMLNK_func",	SYMLNK,,,	"I1:-:Path1=A1,Path2=A1")
-DEFIMP	(SYMLNK_subr,	"SYMLNK_subr",	SYMLNK,,,	"--:-:Path1=A1,Path2=A1,Status=?I1w")
-DEFIMP	(SYSTEM_func,	"SYSTEM_func",	SYSTEM,SYSTEM,SYSTEM,"I1:-:Command=A1")
-DEFIMP	(SYSTEM_subr,	"SYSTEM_subr",	SYSTEM,,,	"--:-:Command=A1,Status=?I1w")
-DEFIMP	(SYSTEM_CLOCK,	"SYSTEM_CLOCK",	SYSTEM_CLOCK,,,	"--:-:Count=I1w,Rate=?I1w,Max=?I1w")
-DEFIMP	(TIME8,		"TIME8",	TIME,,,		"I2:-:")
-DEFIMP	(TIME_unix,	"TIME_unix",	TIME,,,		"I1:-:")
-DEFIMP	(TIME_vxt,	"TIME_vxt",	VXTTIME,,,	"--:-:Time=A1[8]w")
-DEFIMP	(TTYNAM_func,	"TTYNAM_func",	TTYNAM,,,	"A1*:-:Unit=I*")
-DEFIMP	(TTYNAM_subr,	"TTYNAM_subr",	TTYNAM,,,	"--:-:Unit=I*,Name=A1w")
-DEFIMP	(UMASK_func,	"UMASK_func",	UMASK,,,	"I1:-:Mask=I*")
-DEFIMP	(UMASK_subr,	"UMASK_subr",	UMASK,,,	"--:-:Mask=I*,Old=?I1w")
-DEFIMP	(UNLINK_func,	"UNLINK_func",	UNLINK,,,	"I1:-:File=A1")
-DEFIMP	(UNLINK_subr,	"UNLINK_subr",	UNLINK,,,	"--:-:File=A1,Status=?I1w")
-DEFIMP	(XOR,		"XOR",		,,,		"B=:*:I=B*,J=B*")
-DEFIMP	(NONE,		"none",		,,,		"")
diff --git a/gcc/f/intrin.h b/gcc/f/intrin.h
deleted file mode 100644
index e741e69..0000000
--- a/gcc/f/intrin.h
+++ /dev/null
@@ -1,135 +0,0 @@
-/* intrin.h -- Public interface for intrin.c
-   Copyright (C) 1995, 1996, 1997 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-*/
-
-#ifndef GCC_F_INTRIN_H
-#define GCC_F_INTRIN_H
-
-#ifndef FFEINTRIN_DOC
-#define FFEINTRIN_DOC 0	/* 1 means intrinsic documentation only (intdoc.c). */
-#endif
-
-typedef enum
-  {
-    FFEINTRIN_familyNONE,	/* Not in any family. */
-    FFEINTRIN_familyF77,	/* ANSI FORTRAN 77. */
-    FFEINTRIN_familyGNU,	/* GNU Fortran intrinsics. */
-    FFEINTRIN_familyF2C,	/* f2c intrinsics. */
-    FFEINTRIN_familyF90,	/* Fortran 90. */
-    FFEINTRIN_familyF95 = FFEINTRIN_familyF90,
-    FFEINTRIN_familyVXT,	/* VAX/VMS FORTRAN. */
-    FFEINTRIN_familyMIL,	/* MIL STD 1753 (MVBITS, etc), in mil, vxt, and f90. */
-    FFEINTRIN_familyASC,	/* ASCII-related (ACHAR, IACHAR), both f2c and f90. */
-    FFEINTRIN_familyFVZ,	/* in both f2c and VAX/VMS FORTRAN. */
-    FFEINTRIN_familyF2U,	/* libf2c/libU77 UNIX system intrinsics. */
-    FFEINTRIN_familyBADU77,	/* libU77 UNIX system intrinsics with bad form. */
-    FFEINTRIN_family
-  } ffeintrinFamily;
-
-typedef enum
-  {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2) FFEINTRIN_gen ## CODE,
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-    FFEINTRIN_gen
-  } ffeintrinGen;
-
-typedef enum
-  {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP) FFEINTRIN_spec ## CODE,
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL)
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD)
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-    FFEINTRIN_spec
-  } ffeintrinSpec;
-
-typedef enum
-  {
-#define DEFNAME(UPPER,LOWER,MIXED,GEN,SPEC)
-#define DEFGEN(CODE,NAME,SPEC1,SPEC2)
-#define DEFSPEC(CODE,NAME,CALLABLE,FAMILY,IMP)
-#define DEFIMP(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL) \
-    FFEINTRIN_imp ## CODE,
-#define DEFIMPY(CODE,NAME,GFRTDIRECT,GFRTF2C,GFRTGNU,CONTROL,Y2KBAD) \
-    FFEINTRIN_imp ## CODE,
-#include "intrin.def"
-#undef DEFNAME
-#undef DEFGEN
-#undef DEFSPEC
-#undef DEFIMP
-#undef DEFIMPY
-    FFEINTRIN_imp
-  } ffeintrinImp;
-
-#if !FFEINTRIN_DOC
-
-#include "bld.h"
-#include "info.h"
-
-ffeinfoBasictype ffeintrin_basictype (ffeintrinSpec spec);
-ffeintrinFamily ffeintrin_family (ffeintrinSpec spec);
-void ffeintrin_fulfill_generic (ffebld *expr, ffeinfo *info, ffelexToken t);
-void ffeintrin_fulfill_specific (ffebld *expr, ffeinfo *info,
-				 bool *check_intrin, ffelexToken t);
-ffecomGfrt ffeintrin_gfrt_direct (ffeintrinImp imp);
-ffecomGfrt ffeintrin_gfrt_indirect (ffeintrinImp imp);
-void ffeintrin_init_0 (void);
-#define ffeintrin_init_1()
-#define ffeintrin_init_2()
-#define ffeintrin_init_3()
-#define ffeintrin_init_4()
-bool ffeintrin_is_actualarg (ffeintrinSpec spec);
-bool ffeintrin_is_intrinsic (const char *name, ffelexToken t, bool explicit,
-			     ffeintrinGen *gen, ffeintrinSpec *spec,
-			     ffeintrinImp *imp);
-bool ffeintrin_is_standard (ffeintrinGen gen, ffeintrinSpec spec);
-ffeinfoKindtype ffeintrin_kindtype (ffeintrinSpec spec);
-const char *ffeintrin_name_generic (ffeintrinGen gen);
-const char *ffeintrin_name_implementation (ffeintrinImp imp);
-const char *ffeintrin_name_specific (ffeintrinSpec spec);
-ffeIntrinsicState ffeintrin_state_family (ffeintrinFamily family);
-#define ffeintrin_terminate_0()
-#define ffeintrin_terminate_1()
-#define ffeintrin_terminate_2()
-#define ffeintrin_terminate_3()
-#define ffeintrin_terminate_4()
-
-#endif	/* !FFEINTRIN_DOC */
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_INTRIN_H */
diff --git a/gcc/f/invoke.texi b/gcc/f/invoke.texi
deleted file mode 100644
index fd1b804..0000000
--- a/gcc/f/invoke.texi
+++ /dev/null
@@ -1,2233 +0,0 @@
-@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, 2004
-Free Software Foundation, Inc.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with the
-Invariant Sections being ``GNU General Public License'' and ``Funding
-Free Software'', the Front-Cover texts being (a) (see below), and with
-the Back-Cover Texts being (b) (see below).  A copy of the license is
-included in the gfdl(7) man page.
- 
-(a) The FSF's Front-Cover Text is:
-
-     A GNU Manual
-
-(b) The FSF's Back-Cover Text is:
-
-     You have freedom to copy and modify this GNU Manual, like GNU
-     software.  Copies published by the Free Software Foundation raise
-     funds for GNU development.
-@c man end
-@c Set file name and title for the man page.
-@setfilename g77
-@settitle GNU project Fortran 77 compiler.
-@c man begin SYNOPSIS
-g77 [@option{-c}|@option{-S}|@option{-E}]
-    [@option{-g}] [@option{-pg}] [@option{-O}@var{level}]
-    [@option{-W}@var{warn}@dots{}] [@option{-pedantic}]
-    [@option{-I}@var{dir}@dots{}] [@option{-L}@var{dir}@dots{}]
-    [@option{-D}@var{macro}[=@var{defn}]@dots{}] [@option{-U}@var{macro}]
-    [@option{-f}@var{option}@dots{}] [@option{-m}@var{machine-option}@dots{}]
-    [@option{-o} @var{outfile}] @var{infile}@dots{}
-
-Only the most useful options are listed here; see below for the
-remainder.
-@c man end
-@c man begin SEEALSO
-gpl(7), gfdl(7), fsf-funding(7),
-cpp(1), gcov(1), gcc(1), as(1), ld(1), gdb(1), adb(1), dbx(1), sdb(1)
-and the Info entries for @file{gcc}, @file{cpp}, @file{g77}, @file{as},
-@file{ld}, @file{binutils} and @file{gdb}.
-@c man end
-@c man begin BUGS
-For instructions on reporting bugs, see
-@w{@uref{http://gcc.gnu.org/bugs.html}}.  Use of the @command{gccbug}  
-script to report bugs is recommended.
-@c man end
-@c man begin AUTHOR
-See the Info entry for @command{g77} for contributors to GCC and G77@.
-@c man end
-@end ignore
-
-@node Invoking G77
-@chapter GNU Fortran Command Options
-@cindex GNU Fortran command options
-@cindex command options
-@cindex options, GNU Fortran command
-
-@c man begin DESCRIPTION
-
-The @command{g77} command supports all the options supported by the
-@command{gcc} command.
-@xref{Invoking GCC,,GCC Command Options,gcc,Using the GNU Compiler
-Collection (GCC)}, for information
-on the non-Fortran-specific aspects of the @command{gcc} command (and,
-therefore, the @command{g77} command).
-
-@cindex options, negative forms
-@cindex negative forms of options
-All @command{gcc} and @command{g77} options
-are accepted both by @command{g77} and by @command{gcc}
-(as well as any other drivers built at the same time,
-such as @command{g++}),
-since adding @command{g77} to the @command{gcc} distribution
-enables acceptance of @command{g77} options
-by all of the relevant drivers.
-
-In some cases, options have positive and negative forms;
-the negative form of @option{-ffoo} would be @option{-fno-foo}.
-This manual documents only one of these two forms, whichever
-one is not the default.
-
-@c man end
-
-@menu
-* Option Summary::      Brief list of all @command{g77} options,
-                        without explanations.
-* Overall Options::     Controlling the kind of output:
-                        an executable, object files, assembler files,
-                        or preprocessed source.
-* Shorthand Options::   Options that are shorthand for other options.
-* Fortran Dialect Options::  Controlling the variant of Fortran language
-                             compiled.
-* Warning Options::     How picky should the compiler be?
-* Debugging Options::   Symbol tables, measurements, and debugging dumps.
-* Optimize Options::    How much optimization?
-* Preprocessor Options:: Controlling header files and macro definitions.
-                         Also, getting dependency information for Make.
-* Directory Options::   Where to find header files and libraries.
-                        Where to find the compiler executable files.
-* Code Gen Options::    Specifying conventions for function calls, data layout
-                        and register usage.
-* Environment Variables:: Env vars that affect GNU Fortran.
-@end menu
-
-@node Option Summary
-@section Option Summary
-
-@c man begin OPTIONS
-
-Here is a summary of all the options specific to GNU Fortran, grouped
-by type.  Explanations are in the following sections.
-
-@table @emph
-@item Overall Options
-@xref{Overall Options,,Options Controlling the Kind of Output}.
-@gccoptlist{
--fversion  -fset-g77-defaults  -fno-silent}
-
-@item Shorthand Options
-@xref{Shorthand Options}.
-@gccoptlist{
--ff66  -fno-f66  -ff77  -fno-f77  -fno-ugly}
-
-@item Fortran Language Options
-@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect}.
-@gccoptlist{
--ffree-form  -fno-fixed-form  -ff90 @gol
--fvxt  -fdollar-ok  -fno-backslash @gol
--fno-ugly-args  -fno-ugly-assign  -fno-ugly-assumed @gol
--fugly-comma  -fugly-complex  -fugly-init  -fugly-logint @gol
--fonetrip  -ftypeless-boz @gol
--fintrin-case-initcap  -fintrin-case-upper @gol
--fintrin-case-lower  -fintrin-case-any @gol
--fmatch-case-initcap  -fmatch-case-upper @gol
--fmatch-case-lower  -fmatch-case-any @gol
--fsource-case-upper  -fsource-case-lower @gol
--fsource-case-preserve @gol
--fsymbol-case-initcap  -fsymbol-case-upper @gol
--fsymbol-case-lower  -fsymbol-case-any @gol
--fcase-strict-upper  -fcase-strict-lower @gol
--fcase-initcap  -fcase-upper  -fcase-lower  -fcase-preserve @gol
--ff2c-intrinsics-delete  -ff2c-intrinsics-hide @gol
--ff2c-intrinsics-disable  -ff2c-intrinsics-enable @gol
--fbadu77-intrinsics-delete  -fbadu77-intrinsics-hide @gol
--fbadu77-intrinsics-disable  -fbadu77-intrinsics-enable @gol
--ff90-intrinsics-delete  -ff90-intrinsics-hide @gol
--ff90-intrinsics-disable  -ff90-intrinsics-enable @gol
--fgnu-intrinsics-delete  -fgnu-intrinsics-hide @gol
--fgnu-intrinsics-disable  -fgnu-intrinsics-enable @gol
--fmil-intrinsics-delete  -fmil-intrinsics-hide @gol
--fmil-intrinsics-disable  -fmil-intrinsics-enable @gol
--funix-intrinsics-delete  -funix-intrinsics-hide @gol
--funix-intrinsics-disable  -funix-intrinsics-enable @gol
--fvxt-intrinsics-delete  -fvxt-intrinsics-hide @gol
--fvxt-intrinsics-disable  -fvxt-intrinsics-enable @gol
--ffixed-line-length-@var{n}  -ffixed-line-length-none}
-
-@item Warning Options
-@xref{Warning Options,,Options to Request or Suppress Warnings}.
-@gccoptlist{
--fsyntax-only  -pedantic  -pedantic-errors  -fpedantic @gol
--w  -Wno-globals  -Wimplicit  -Wunused  -Wuninitialized @gol
--Wall  -Wsurprising @gol
--Werror  -W}
-
-@item Debugging Options
-@xref{Debugging Options,,Options for Debugging Your Program or GCC}.
-@gccoptlist{
--g}
-
-@item Optimization Options
-@xref{Optimize Options,,Options that Control Optimization}.
-@gccoptlist{
--malign-double @gol
--ffloat-store  -fforce-mem  -fforce-addr  -fno-inline @gol
--ffast-math  -fstrength-reduce  -frerun-cse-after-loop @gol
--funsafe-math-optimizations -ffinite-math-only -fno-trapping-math @gol
--fexpensive-optimizations  -fdelayed-branch @gol
--fschedule-insns  -fschedule-insn2  -fcaller-saves @gol
--funroll-loops  -funroll-all-loops @gol
--fno-move-all-movables  -fno-reduce-all-givs @gol
--fno-rerun-loop-opt}
-
-@item Directory Options
-@xref{Directory Options,,Options for Directory Search}.
-@gccoptlist{
--I@var{dir}  -I-}
-
-@item Code Generation Options
-@xref{Code Gen Options,,Options for Code Generation Conventions}.
-@gccoptlist{
--fno-automatic  -finit-local-zero  -fno-f2c @gol
--ff2c-library  -fno-underscoring  -fno-ident @gol
--fpcc-struct-return  -freg-struct-return @gol
--fshort-double  -fno-common  -fpack-struct @gol
--fzeros  -fno-second-underscore @gol
--femulate-complex @gol
--falias-check  -fargument-alias @gol
--fargument-noalias  -fno-argument-noalias-global @gol
--fno-globals  -fflatten-arrays @gol
--fbounds-check  -ffortran-bounds-check}
-@end table
-
-@c man end
-
-@menu
-* Overall Options::     Controlling the kind of output:
-                        an executable, object files, assembler files,
-                        or preprocessed source.
-* Shorthand Options::   Options that are shorthand for other options.
-* Fortran Dialect Options::  Controlling the variant of Fortran language
-                             compiled.
-* Warning Options::     How picky should the compiler be?
-* Debugging Options::   Symbol tables, measurements, and debugging dumps.
-* Optimize Options::    How much optimization?
-* Preprocessor Options:: Controlling header files and macro definitions.
-                         Also, getting dependency information for Make.
-* Directory Options::   Where to find header files and libraries.
-                        Where to find the compiler executable files.
-* Code Gen Options::    Specifying conventions for function calls, data layout
-                        and register usage.
-@end menu
-
-@node Overall Options
-@section Options Controlling the Kind of Output
-@cindex overall options
-@cindex options, overall
-
-@c man begin OPTIONS
-
-Compilation can involve as many as four stages: preprocessing, code
-generation (often what is really meant by the term ``compilation''),
-assembly, and linking, always in that order.  The first three
-stages apply to an individual source file, and end by producing an
-object file; linking combines all the object files (those newly
-compiled, and those specified as input) into an executable file.
-
-@cindex file name suffix
-@cindex suffixes, file name
-@cindex file name extension
-@cindex extensions, file name
-@cindex file type
-@cindex types, file
-For any given input file, the file name suffix determines what kind of
-program is contained in the file---that is, the language in which the
-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 GCC.
-
-@table @gcctabopt
-@cindex .f filename suffix
-@cindex .for filename suffix
-@cindex .FOR filename suffix
-@item @var{file}.f
-@item @var{file}.for
-@item @var{file}.FOR
-Fortran source code that should not be preprocessed.
-
-Such source code cannot contain any preprocessor directives, such
-as @code{#include}, @code{#define}, @code{#if}, and so on.
-
-You can force @samp{.f} files to be preprocessed by @command{cpp} by using
-@option{-x f77-cpp-input}.
-@xref{LEX}.
-
-@cindex preprocessor
-@cindex C preprocessor
-@cindex cpp preprocessor
-@cindex Fortran preprocessor
-@cindex cpp program
-@cindex programs, cpp
-@cindex .F filename suffix
-@cindex .fpp filename suffix
-@cindex .FPP filename suffix
-@item @var{file}.F
-@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 GCC).
-
-Note that preprocessing is not extended to the contents of
-files included by the @code{INCLUDE} directive---the @code{#include}
-preprocessor directive must be used instead.
-
-@cindex Ratfor preprocessor
-@cindex programs, @command{ratfor}
-@cindex @samp{.r} filename suffix
-@cindex @command{ratfor}
-@item @var{file}.r
-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).
-A public domain version in C is at
-@uref{http://sepwww.stanford.edu/sep/prof/ratfor.shar.2}.
-@end table
-
-UNIX users typically use the @file{@var{file}.f} and @file{@var{file}.F}
-nomenclature.
-Users of other operating systems, especially those that cannot
-distinguish upper-case
-letters from lower-case letters in their file names, typically use
-the @file{@var{file}.for} and @file{@var{file}.fpp} nomenclature.
-
-@cindex #define
-@cindex #include
-@cindex #if
-Use of the preprocessor @command{cpp} allows use of C-like
-constructs such as @code{#define} and @code{#include}, but can
-lead to unexpected, even mistaken, results due to Fortran's source file
-format.
-It is recommended that use of the C preprocessor
-be limited to @code{#include} and, in
-conjunction with @code{#define}, only @code{#if} and related directives,
-thus avoiding in-line macro expansion entirely.
-This recommendation applies especially
-when using the traditional fixed source form.
-With free source form,
-fewer unexpected transformations are likely to happen, but use of
-constructs such as Hollerith and character constants can nevertheless
-present problems, especially when these are continued across multiple
-source lines.
-These problems result, primarily, from differences between the way
-such constants are interpreted by the C preprocessor and by a Fortran
-compiler.
-
-Another example of a problem that results from using the C preprocessor
-is that a Fortran comment line that happens to contain any
-characters ``interesting'' to the C preprocessor,
-such as a backslash at the end of the line,
-is not recognized by the preprocessor as a comment line,
-so instead of being passed through ``raw'',
-the line is edited according to the rules for the preprocessor.
-For example, the backslash at the end of the line is removed,
-along with the subsequent newline, resulting in the next
-line being effectively commented out---unfortunate if that
-line is a non-comment line of important code!
-
-@emph{Note:} The @option{-traditional} and @option{-undef} flags are supplied
-to @command{cpp} by default, to help avoid unpleasant surprises.
-@xref{Preprocessor Options,,Options Controlling the Preprocessor,
-gcc,Using the GNU Compiler Collection (GCC)}.
-This means that ANSI C preprocessor features (such as the @samp{#}
-operator) aren't available, and only variables in the C reserved
-namespace (generally, names with a leading underscore) are liable to
-substitution by C predefines.
-Thus, if you want to do system-specific
-tests, use, for example, @samp{#ifdef __linux__} rather than @samp{#ifdef linux}.
-Use the @option{-v} option to see exactly how the preprocessor is invoked.
-
-@cindex /*
-Unfortunately, the @option{-traditional} flag will not avoid an error from
-anything that @command{cpp} sees as an unterminated C comment, such as:
-@smallexample
-C Some Fortran compilers accept /* as starting
-C an inline comment.
-@end smallexample
-@xref{Trailing Comment}.
-
-The following options that affect overall processing are recognized
-by the @command{g77} and @command{gcc} commands in a GNU Fortran installation:
-
-@table @gcctabopt
-@cindex -fversion option
-@cindex options, -fversion
-@cindex printing version information
-@cindex version information, printing
-@cindex consistency checks
-@cindex internal consistency checks
-@cindex checks, of internal consistency
-@item -fversion
-Ensure that the @command{g77} version of the compiler phase is reported,
-if run,
-and, starting in @code{egcs} version 1.1,
-that internal consistency checks in the @file{f771} program are run.
-
-This option is supplied automatically when @option{-v} or @option{--verbose}
-is specified as a command-line option for @command{g77} or @command{gcc}
-and when the resulting commands compile Fortran source files.
-
-In GCC 3.1, this is changed back to the behavior @command{gcc} displays
-for @samp{.c} files.
-
-@cindex -fset-g77-defaults option
-@cindex options, -fset-g77-defaults
-@item -fset-g77-defaults
-@emph{Version info:}
-This option was obsolete as of @code{egcs}
-version 1.1.
-The effect is instead achieved
-by the @code{lang_init_options} routine
-in @file{gcc/gcc/f/com.c}.
-
-@cindex consistency checks
-@cindex internal consistency checks
-@cindex checks, of internal consistency
-Set up whatever @command{gcc} options are to apply to Fortran
-compilations, and avoid running internal consistency checks
-that might take some time.
-
-This option is supplied automatically when compiling Fortran code
-via the @command{g77} or @command{gcc} command.
-The description of this option is provided so that users seeing
-it in the output of, say, @samp{g77 -v} understand why it is
-there.
-
-@cindex modifying @command{g77}
-@cindex @command{g77}, modifying
-Also, developers who run @code{f771} directly might want to specify it
-by hand to get the same defaults as they would running @code{f771}
-via @command{g77} or @command{gcc}
-However, such developers should, after linking a new @code{f771}
-executable, invoke it without this option once,
-e.g. via @kbd{./f771 -quiet < /dev/null},
-to ensure that they have not introduced any
-internal inconsistencies (such as in the table of
-intrinsics) before proceeding---@command{g77} will crash
-with a diagnostic if it detects an inconsistency.
-
-@cindex -fno-silent option
-@cindex options, -fno-silent
-@cindex f2c compatibility
-@cindex compatibility, f2c
-@cindex status, compilation
-@cindex compilation, status
-@cindex reporting compilation status
-@cindex printing compilation status
-@item -fno-silent
-Print (to @code{stderr}) the names of the program units as
-they are compiled, in a form similar to that used by popular
-UNIX @command{f77} implementations and @command{f2c}
-@end table
-
-@xref{Overall Options,,Options Controlling the Kind of Output,
-gcc,Using the GNU Compiler Collection (GCC)}, for information
-on more options that control the overall operation of the @command{gcc} command
-(and, by extension, the @command{g77} command).
-
-@node Shorthand Options
-@section Shorthand Options
-@cindex shorthand options
-@cindex options, shorthand
-@cindex macro options
-@cindex options, macro
-
-The following options serve as ``shorthand''
-for other options accepted by the compiler:
-
-@table @gcctabopt
-@cindex -fugly option
-@cindex options, -fugly
-@item -fugly
-@cindex ugly features
-@cindex features, ugly
-@emph{Note:} This option is no longer supported.
-The information, below, is provided to aid
-in the conversion of old scripts.
-
-Specify that certain ``ugly'' constructs are to be quietly accepted.
-Same as:
-
-@smallexample
--fugly-args -fugly-assign -fugly-assumed
--fugly-comma -fugly-complex -fugly-init
--fugly-logint
-@end smallexample
-
-These constructs are considered inappropriate to use in new
-or well-maintained portable Fortran code, but widely used
-in old code.
-@xref{Distensions}, for more information.
-
-@cindex -fno-ugly option
-@cindex options, -fno-ugly
-@item -fno-ugly
-@cindex ugly features
-@cindex features, ugly
-Specify that all ``ugly'' constructs are to be noisily rejected.
-Same as:
-
-@smallexample
--fno-ugly-args -fno-ugly-assign -fno-ugly-assumed
--fno-ugly-comma -fno-ugly-complex -fno-ugly-init
--fno-ugly-logint
-@end smallexample
-
-@xref{Distensions}, for more information.
-
-@cindex -ff66 option
-@cindex options, -ff66
-@item -ff66
-@cindex FORTRAN 66
-@cindex compatibility, FORTRAN 66
-Specify that the program is written in idiomatic FORTRAN 66.
-Same as @samp{-fonetrip -fugly-assumed}.
-
-The @option{-fno-f66} option is the inverse of @option{-ff66}.
-As such, it is the same as @samp{-fno-onetrip -fno-ugly-assumed}.
-
-The meaning of this option is likely to be refined as future
-versions of @command{g77} provide more compatibility with other
-existing and obsolete Fortran implementations.
-
-@cindex -ff77 option
-@cindex options, -ff77
-@item -ff77
-@cindex UNIX f77
-@cindex f2c compatibility
-@cindex compatibility, f2c
-@cindex f77 compatibility
-@cindex compatibility, f77
-Specify that the program is written in idiomatic UNIX FORTRAN 77
-and/or the dialect accepted by the @command{f2c} product.
-Same as @samp{-fbackslash -fno-typeless-boz}.
-
-The meaning of this option is likely to be refined as future
-versions of @command{g77} provide more compatibility with other
-existing and obsolete Fortran implementations.
-
-@cindex -fno-f77 option
-@cindex options, -fno-f77
-@item -fno-f77
-@cindex UNIX f77
-The @option{-fno-f77} option is @emph{not} the inverse
-of @option{-ff77}.
-It specifies that the program is not written in idiomatic UNIX
-FORTRAN 77 or @command{f2c} but in a more widely portable dialect.
-@option{-fno-f77} is the same as @option{-fno-backslash}.
-
-The meaning of this option is likely to be refined as future
-versions of @command{g77} provide more compatibility with other
-existing and obsolete Fortran implementations.
-@end table
-
-@node Fortran Dialect Options
-@section Options Controlling Fortran Dialect
-@cindex dialect options
-@cindex language, dialect options
-@cindex options, dialect
-
-The following options control the dialect of Fortran
-that the compiler accepts:
-
-@table @gcctabopt
-@cindex -ffree-form option
-@cindex options, -ffree-form
-@cindex -fno-fixed-form option
-@cindex options, -fno-fixed-form
-@cindex source file format
-@cindex free form
-@cindex fixed form
-@cindex Fortran 90, features
-@item -ffree-form
-@item -fno-fixed-form
-Specify that the source file is written in free form
-(introduced in Fortran 90) instead of the more-traditional fixed form.
-
-@cindex -ff90 option
-@cindex options, -ff90
-@cindex Fortran 90, features
-@item -ff90
-Allow certain Fortran-90 constructs.
-
-This option controls whether certain
-Fortran 90 constructs are recognized.
-(Other Fortran 90 constructs
-might or might not be recognized depending on other options such as
-@option{-fvxt}, @option{-ff90-intrinsics-enable}, and the
-current level of support for Fortran 90.)
-
-@xref{Fortran 90}, for more information.
-
-@cindex -fvxt option
-@cindex options, -fvxt
-@item -fvxt
-@cindex Fortran 90, features
-@cindex VXT extensions
-Specify the treatment of certain constructs that have different
-meanings depending on whether the code is written in
-GNU Fortran (based on FORTRAN 77 and akin to Fortran 90)
-or VXT Fortran (more like VAX FORTRAN).
-
-The default is @option{-fno-vxt}.
-@option{-fvxt} specifies that the VXT Fortran interpretations
-for those constructs are to be chosen.
-
-@xref{VXT Fortran}, for more information.
-
-@cindex -fdollar-ok option
-@cindex options, -fdollar-ok
-@item -fdollar-ok
-@cindex dollar sign
-@cindex symbol names
-@cindex character set
-Allow @samp{$} as a valid character in a symbol name.
-
-@cindex -fno-backslash option
-@cindex options, -fno-backslash
-@item -fno-backslash
-@cindex backslash
-@cindex character constants
-@cindex Hollerith constants
-Specify that @samp{\} is not to be specially interpreted in character
-and Hollerith constants a la C and many UNIX Fortran compilers.
-
-For example, with @option{-fbackslash} in effect, @samp{A\nB} specifies
-three characters, with the second one being newline.
-With @option{-fno-backslash}, it specifies four characters,
-@samp{A}, @samp{\}, @samp{n}, and @samp{B}.
-
-Note that @command{g77} implements a fairly general form of backslash
-processing that is incompatible with the narrower forms supported
-by some other compilers.
-For example, @samp{'A\003B'} is a three-character string in @command{g77}
-whereas other compilers that support backslash might not support
-the three-octal-digit form, and thus treat that string as longer
-than three characters.
-
-@xref{Backslash in Constants}, for
-information on why @option{-fbackslash} is the default
-instead of @option{-fno-backslash}.
-
-@cindex -fno-ugly-args option
-@cindex options, -fno-ugly-args
-@item -fno-ugly-args
-Disallow passing Hollerith and typeless constants as actual
-arguments (for example, @samp{CALL FOO(4HABCD)}).
-
-@xref{Ugly Implicit Argument Conversion}, for more information.
-
-@cindex -fugly-assign option
-@cindex options, -fugly-assign
-@item -fugly-assign
-Use the same storage for a given variable regardless of
-whether it is used to hold an assigned-statement label
-(as in @samp{ASSIGN 10 TO I}) or used to hold numeric data
-(as in @samp{I = 3}).
-
-@xref{Ugly Assigned Labels}, for more information.
-
-@cindex -fugly-assumed option
-@cindex options, -fugly-assumed
-@item -fugly-assumed
-Assume any dummy array with a final dimension specified as @samp{1}
-is really an assumed-size array, as if @samp{*} had been specified
-for the final dimension instead of @samp{1}.
-
-For example, @samp{DIMENSION X(1)} is treated as if it
-had read @samp{DIMENSION X(*)}.
-
-@xref{Ugly Assumed-Size Arrays}, for more information.
-
-@cindex -fugly-comma option
-@cindex options, -fugly-comma
-@item -fugly-comma
-In an external-procedure invocation,
-treat a trailing comma in the argument list
-as specification of a trailing null argument,
-and treat an empty argument list
-as specification of a single null argument.
-
-For example, @samp{CALL FOO(,)} is treated as
-@samp{CALL FOO(%VAL(0), %VAL(0))}.
-That is, @emph{two} null arguments are specified
-by the procedure call when @option{-fugly-comma} is in force.
-And @samp{F = FUNC()} is treated as @samp{F = FUNC(%VAL(0))}.
-
-The default behavior, @option{-fno-ugly-comma}, is to ignore
-a single trailing comma in an argument list.
-So, by default, @samp{CALL FOO(X,)} is treated
-exactly the same as @samp{CALL FOO(X)}.
-
-@xref{Ugly Null Arguments}, for more information.
-
-@cindex -fugly-complex option
-@cindex options, -fugly-complex
-@item -fugly-complex
-Do not complain about @samp{REAL(@var{expr})} or
-@samp{AIMAG(@var{expr})} when @var{expr} is a @code{COMPLEX}
-type other than @code{COMPLEX(KIND=1)}---usually
-this is used to permit @code{COMPLEX(KIND=2)}
-(@code{DOUBLE COMPLEX}) operands.
-
-The @option{-ff90} option controls the interpretation
-of this construct.
-
-@xref{Ugly Complex Part Extraction}, for more information.
-
-@cindex -fno-ugly-init option
-@cindex options, -fno-ugly-init
-@item -fno-ugly-init
-Disallow use of Hollerith and typeless constants as initial
-values (in @code{PARAMETER} and @code{DATA} statements), and
-use of character constants to
-initialize numeric types and vice versa.
-
-For example, @samp{DATA I/'F'/, CHRVAR/65/, J/4HABCD/} is disallowed by
-@option{-fno-ugly-init}.
-
-@xref{Ugly Conversion of Initializers}, for more information.
-
-@cindex -fugly-logint option
-@cindex options, -fugly-logint
-@item -fugly-logint
-Treat @code{INTEGER} and @code{LOGICAL} variables and
-expressions as potential stand-ins for each other.
-
-For example, automatic conversion between @code{INTEGER} and
-@code{LOGICAL} is enabled, for many contexts, via this option.
-
-@xref{Ugly Integer Conversions}, for more information.
-
-@cindex -fonetrip option
-@cindex options, -fonetrip
-@item -fonetrip
-@cindex FORTRAN 66
-@cindex @code{DO} loops, one-trip
-@cindex one-trip @code{DO} loops
-@cindex @code{DO} loops, zero-trip
-@cindex zero-trip @code{DO} loops
-@cindex compatibility, FORTRAN 66
-Executable iterative @code{DO} loops are to be executed at
-least once each time they are reached.
-
-ANSI FORTRAN 77 and more recent versions of the Fortran standard
-specify that the body of an iterative @code{DO} loop is not executed
-if the number of iterations calculated from the parameters of the
-loop is less than 1.
-(For example, @samp{DO 10 I = 1, 0}.)
-Such a loop is called a @dfn{zero-trip loop}.
-
-Prior to ANSI FORTRAN 77, many compilers implemented @code{DO} loops
-such that the body of a loop would be executed at least once, even
-if the iteration count was zero.
-Fortran code written assuming this behavior is said to require
-@dfn{one-trip loops}.
-For example, some code written to the FORTRAN 66 standard
-expects this behavior from its @code{DO} loops, although that
-standard did not specify this behavior.
-
-The @option{-fonetrip} option specifies that the source file(s) being
-compiled require one-trip loops.
-
-This option affects only those loops specified by the (iterative) @code{DO}
-statement and by implied-@code{DO} lists in I/O statements.
-Loops specified by implied-@code{DO} lists in @code{DATA} and
-specification (non-executable) statements are not affected.
-
-@cindex -ftypeless-boz option
-@cindex options, -ftypeless-boz
-@cindex prefix-radix constants
-@cindex constants, prefix-radix
-@cindex constants, types
-@cindex types, constants
-@item -ftypeless-boz
-Specifies that prefix-radix non-decimal constants, such as
-@samp{Z'ABCD'}, are typeless instead of @code{INTEGER(KIND=1)}.
-
-You can test for yourself whether a particular compiler treats
-the prefix form as @code{INTEGER(KIND=1)} or typeless by running the
-following program:
-
-@smallexample
-EQUIVALENCE (I, R)
-R = Z'ABCD1234'
-J = Z'ABCD1234'
-IF (J .EQ. I) PRINT *, 'Prefix form is TYPELESS'
-IF (J .NE. I) PRINT *, 'Prefix form is INTEGER'
-END
-@end smallexample
-
-Reports indicate that many compilers process this form as
-@code{INTEGER(KIND=1)}, though a few as typeless, and at least one
-based on a command-line option specifying some kind of
-compatibility.
-
-@cindex -fintrin-case-initcap option
-@cindex options, -fintrin-case-initcap
-@item -fintrin-case-initcap
-@cindex -fintrin-case-upper option
-@cindex options, -fintrin-case-upper
-@item -fintrin-case-upper
-@cindex -fintrin-case-lower option
-@cindex options, -fintrin-case-lower
-@item -fintrin-case-lower
-@cindex -fintrin-case-any option
-@cindex options, -fintrin-case-any
-@item -fintrin-case-any
-Specify expected case for intrinsic names.
-@option{-fintrin-case-lower} is the default.
-
-@cindex -fmatch-case-initcap option
-@cindex options, -fmatch-case-initcap
-@item -fmatch-case-initcap
-@cindex -fmatch-case-upper option
-@cindex options, -fmatch-case-upper
-@item -fmatch-case-upper
-@cindex -fmatch-case-lower option
-@cindex options, -fmatch-case-lower
-@item -fmatch-case-lower
-@cindex -fmatch-case-any option
-@cindex options, -fmatch-case-any
-@item -fmatch-case-any
-Specify expected case for keywords.
-@option{-fmatch-case-lower} is the default.
-
-@cindex -fsource-case-upper option
-@cindex options, -fsource-case-upper
-@item -fsource-case-upper
-@cindex -fsource-case-lower option
-@cindex options, -fsource-case-lower
-@item -fsource-case-lower
-@cindex -fsource-case-preserve option
-@cindex options, -fsource-case-preserve
-@item -fsource-case-preserve
-Specify whether source text other than character and Hollerith constants
-is to be translated to uppercase, to lowercase, or preserved as is.
-@option{-fsource-case-lower} is the default.
-
-@cindex -fsymbol-case-initcap option
-@cindex options, -fsymbol-case-initcap
-@item -fsymbol-case-initcap
-@cindex -fsymbol-case-upper option
-@cindex options, -fsymbol-case-upper
-@item -fsymbol-case-upper
-@cindex -fsymbol-case-lower option
-@cindex options, -fsymbol-case-lower
-@item -fsymbol-case-lower
-@cindex -fsymbol-case-any option
-@cindex options, -fsymbol-case-any
-@item -fsymbol-case-any
-Specify valid cases for user-defined symbol names.
-@option{-fsymbol-case-any} is the default.
-
-@cindex -fcase-strict-upper option
-@cindex options, -fcase-strict-upper
-@item -fcase-strict-upper
-Same as @samp{-fintrin-case-upper -fmatch-case-upper -fsource-case-preserve
--fsymbol-case-upper}.
-(Requires all pertinent source to be in uppercase.)
-
-@cindex -fcase-strict-lower option
-@cindex options, -fcase-strict-lower
-@item -fcase-strict-lower
-Same as @samp{-fintrin-case-lower -fmatch-case-lower -fsource-case-preserve
--fsymbol-case-lower}.
-(Requires all pertinent source to be in lowercase.)
-
-@cindex -fcase-initcap option
-@cindex options, -fcase-initcap
-@item -fcase-initcap
-Same as @samp{-fintrin-case-initcap -fmatch-case-initcap -fsource-case-preserve
--fsymbol-case-initcap}.
-(Requires all pertinent source to be in initial capitals,
-as in @samp{Print *,SqRt(Value)}.)
-
-@cindex -fcase-upper option
-@cindex options, -fcase-upper
-@item -fcase-upper
-Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-upper
--fsymbol-case-any}.
-(Maps all pertinent source to uppercase.)
-
-@cindex -fcase-lower option
-@cindex options, -fcase-lower
-@item -fcase-lower
-Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-lower
--fsymbol-case-any}.
-(Maps all pertinent source to lowercase.)
-
-@cindex -fcase-preserve option
-@cindex options, -fcase-preserve
-@item -fcase-preserve
-Same as @samp{-fintrin-case-any -fmatch-case-any -fsource-case-preserve
--fsymbol-case-any}.
-(Preserves all case in user-defined symbols,
-while allowing any-case matching of intrinsics and keywords.
-For example, @samp{call Foo(i,I)} would pass two @emph{different}
-variables named @samp{i} and @samp{I} to a procedure named @samp{Foo}.)
-
-@cindex -fbadu77-intrinsics-delete option
-@cindex options, -fbadu77-intrinsics-delete
-@item -fbadu77-intrinsics-delete
-@cindex -fbadu77-intrinsics-hide option
-@cindex options, -fbadu77-intrinsics-hide
-@item -fbadu77-intrinsics-hide
-@cindex -fbadu77-intrinsics-disable option
-@cindex options, -fbadu77-intrinsics-disable
-@item -fbadu77-intrinsics-disable
-@cindex -fbadu77-intrinsics-enable option
-@cindex options, -fbadu77-intrinsics-enable
-@item -fbadu77-intrinsics-enable
-@cindex @code{badu77} intrinsics
-@cindex intrinsics, @code{badu77}
-Specify status of UNIX intrinsics having inappropriate forms.
-@option{-fbadu77-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -ff2c-intrinsics-delete option
-@cindex options, -ff2c-intrinsics-delete
-@item -ff2c-intrinsics-delete
-@cindex -ff2c-intrinsics-hide option
-@cindex options, -ff2c-intrinsics-hide
-@item -ff2c-intrinsics-hide
-@cindex -ff2c-intrinsics-disable option
-@cindex options, -ff2c-intrinsics-disable
-@item -ff2c-intrinsics-disable
-@cindex -ff2c-intrinsics-enable option
-@cindex options, -ff2c-intrinsics-enable
-@item -ff2c-intrinsics-enable
-@cindex @command{f2c} intrinsics
-@cindex intrinsics, @command{f2c}
-Specify status of f2c-specific intrinsics.
-@option{-ff2c-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -ff90-intrinsics-delete option
-@cindex options, -ff90-intrinsics-delete
-@item -ff90-intrinsics-delete
-@cindex -ff90-intrinsics-hide option
-@cindex options, -ff90-intrinsics-hide
-@item -ff90-intrinsics-hide
-@cindex -ff90-intrinsics-disable option
-@cindex options, -ff90-intrinsics-disable
-@item -ff90-intrinsics-disable
-@cindex -ff90-intrinsics-enable option
-@cindex options, -ff90-intrinsics-enable
-@item -ff90-intrinsics-enable
-@cindex Fortran 90, intrinsics
-@cindex intrinsics, Fortran 90
-Specify status of F90-specific intrinsics.
-@option{-ff90-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -fgnu-intrinsics-delete option
-@cindex options, -fgnu-intrinsics-delete
-@item -fgnu-intrinsics-delete
-@cindex -fgnu-intrinsics-hide option
-@cindex options, -fgnu-intrinsics-hide
-@item -fgnu-intrinsics-hide
-@cindex -fgnu-intrinsics-disable option
-@cindex options, -fgnu-intrinsics-disable
-@item -fgnu-intrinsics-disable
-@cindex -fgnu-intrinsics-enable option
-@cindex options, -fgnu-intrinsics-enable
-@item -fgnu-intrinsics-enable
-@cindex Digital Fortran features
-@cindex @code{COMPLEX} intrinsics
-@cindex intrinsics, @code{COMPLEX}
-Specify status of Digital's COMPLEX-related intrinsics.
-@option{-fgnu-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -fmil-intrinsics-delete option
-@cindex options, -fmil-intrinsics-delete
-@item -fmil-intrinsics-delete
-@cindex -fmil-intrinsics-hide option
-@cindex options, -fmil-intrinsics-hide
-@item -fmil-intrinsics-hide
-@cindex -fmil-intrinsics-disable option
-@cindex options, -fmil-intrinsics-disable
-@item -fmil-intrinsics-disable
-@cindex -fmil-intrinsics-enable option
-@cindex options, -fmil-intrinsics-enable
-@item -fmil-intrinsics-enable
-@cindex MIL-STD 1753
-@cindex intrinsics, MIL-STD 1753
-Specify status of MIL-STD-1753-specific intrinsics.
-@option{-fmil-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -funix-intrinsics-delete option
-@cindex options, -funix-intrinsics-delete
-@item -funix-intrinsics-delete
-@cindex -funix-intrinsics-hide option
-@cindex options, -funix-intrinsics-hide
-@item -funix-intrinsics-hide
-@cindex -funix-intrinsics-disable option
-@cindex options, -funix-intrinsics-disable
-@item -funix-intrinsics-disable
-@cindex -funix-intrinsics-enable option
-@cindex options, -funix-intrinsics-enable
-@item -funix-intrinsics-enable
-@cindex UNIX intrinsics
-@cindex intrinsics, UNIX
-Specify status of UNIX intrinsics.
-@option{-funix-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -fvxt-intrinsics-delete option
-@cindex options, -fvxt-intrinsics-delete
-@item -fvxt-intrinsics-delete
-@cindex -fvxt-intrinsics-hide option
-@cindex options, -fvxt-intrinsics-hide
-@item -fvxt-intrinsics-hide
-@cindex -fvxt-intrinsics-disable option
-@cindex options, -fvxt-intrinsics-disable
-@item -fvxt-intrinsics-disable
-@cindex -fvxt-intrinsics-enable option
-@cindex options, -fvxt-intrinsics-enable
-@item -fvxt-intrinsics-enable
-@cindex VXT intrinsics
-@cindex intrinsics, VXT
-Specify status of VXT intrinsics.
-@option{-fvxt-intrinsics-enable} is the default.
-@xref{Intrinsic Groups}.
-
-@cindex -ffixed-line-length-@var{n} option
-@cindex options, -ffixed-line-length-@var{n}
-@item -ffixed-line-length-@var{n}
-@cindex source file format
-@cindex lines, length
-@cindex length of source lines
-@cindex fixed form
-@cindex limits, lengths of source lines
-Set column after which characters are ignored in typical fixed-form
-lines in the source file, and through which spaces are assumed (as
-if padded to that length) after the ends of short fixed-form lines.
-
-@cindex card image
-@cindex extended-source option
-Popular values for @var{n} include 72 (the
-standard and the default), 80 (card image), and 132 (corresponds
-to ``extended-source'' options in some popular compilers).
-@var{n} may be @samp{none}, meaning that the entire line is meaningful
-and that continued character constants never have implicit spaces appended
-to them to fill out the line.
-@option{-ffixed-line-length-0} means the same thing as
-@option{-ffixed-line-length-none}.
-
-@xref{Source Form}, for more information.
-@end table
-
-@node Warning Options
-@section Options to Request or Suppress Warnings
-@cindex options, warnings
-@cindex warnings, suppressing
-@cindex messages, warning
-@cindex suppressing warnings
-
-Warnings are diagnostic messages that report constructions which
-are not inherently erroneous but which are risky or suggest there
-might have been an error.
-
-You can request many specific warnings with options beginning @option{-W},
-for example @option{-Wimplicit} to request warnings on implicit
-declarations.  Each of these specific warning options also has a
-negative form beginning @option{-Wno-} to turn off warnings;
-for example, @option{-Wno-implicit}.  This manual lists only one of the
-two forms, whichever is not the default.
-
-These options control the amount and kinds of warnings produced by GNU
-Fortran:
-
-@table @gcctabopt
-@cindex syntax checking
-@cindex -fsyntax-only option
-@cindex options, -fsyntax-only
-@item -fsyntax-only
-Check the code for syntax errors, but don't do anything beyond that.
-
-@cindex -pedantic option
-@cindex options, -pedantic
-@item -pedantic
-Issue warnings for uses of extensions to ANSI FORTRAN 77.
-@option{-pedantic} also applies to C-language constructs where they
-occur in GNU Fortran source files, such as use of @samp{\e} in a
-character constant within a directive like @samp{#include}.
-
-Valid ANSI FORTRAN 77 programs should compile properly with or without
-this option.
-However, without this option, certain GNU extensions and traditional
-Fortran features are supported as well.
-With this option, many of them are rejected.
-
-Some users try to use @option{-pedantic} to check programs for strict ANSI
-conformance.
-They soon find that it does not do quite what they want---it finds some
-non-ANSI practices, but not all.
-However, improvements to @command{g77} in this area are welcome.
-
-@cindex -pedantic-errors option
-@cindex options, -pedantic-errors
-@item -pedantic-errors
-Like @option{-pedantic}, except that errors are produced rather than
-warnings.
-
-@cindex -fpedantic option
-@cindex options, -fpedantic
-@item -fpedantic
-Like @option{-pedantic}, but applies only to Fortran constructs.
-
-@cindex -w option
-@cindex options, -w
-@item -w
-Inhibit all warning messages.
-
-@cindex -Wno-globals option
-@cindex options, -Wno-globals
-@item -Wno-globals
-@cindex global names, warning
-@cindex warnings, global names
-Inhibit warnings about use of a name as both a global name
-(a subroutine, function, or block data program unit, or a
-common block) and implicitly as the name of an intrinsic
-in a source file.
-
-Also inhibit warnings about inconsistent invocations and/or
-definitions of global procedures (function and subroutines).
-Such inconsistencies include different numbers of arguments
-and different types of arguments.
-
-@cindex -Wimplicit option
-@cindex options, -Wimplicit
-@item -Wimplicit
-@cindex implicit declaration, warning
-@cindex warnings, implicit declaration
-@cindex -u option
-@cindex /WARNINGS=DECLARATIONS switch
-@cindex IMPLICIT NONE, similar effect
-@cindex effecting IMPLICIT NONE
-Warn whenever a variable, array, or function is implicitly
-declared.
-Has an effect similar to using the @code{IMPLICIT NONE} statement
-in every program unit.
-(Some Fortran compilers provide this feature by an option
-named @option{-u} or @samp{/WARNINGS=DECLARATIONS}.)
-
-@cindex -Wunused option
-@cindex options, -Wunused
-@item -Wunused
-@cindex unused variables
-@cindex variables, unused
-Warn whenever a variable is unused aside from its declaration.
-
-@cindex -Wuninitialized option
-@cindex options, -Wuninitialized
-@item -Wuninitialized
-@cindex uninitialized variables
-@cindex variables, uninitialized
-Warn whenever an automatic variable is used without first being initialized.
-
-These warnings are possible only in optimizing compilation,
-because they require data-flow information that is computed only
-when optimizing.  If you don't specify @option{-O}, you simply won't
-get these warnings.
-
-These warnings occur only for variables that are candidates for
-register allocation.  Therefore, they do not occur for a variable
-@c that is declared @code{VOLATILE}, or
-whose address is taken, or whose size
-is other than 1, 2, 4 or 8 bytes.  Also, they do not occur for
-arrays, even when they are in registers.
-
-Note that there might be no warning about a variable that is used only
-to compute a value that itself is never used, because such
-computations may be deleted by data-flow analysis before the warnings
-are printed.
-
-These warnings are made optional because GNU Fortran is not smart
-enough to see all the reasons why the code might be correct
-despite appearing to have an error.  Here is one example of how
-this can happen:
-
-@example
-SUBROUTINE DISPAT(J)
-IF (J.EQ.1) I=1
-IF (J.EQ.2) I=4
-IF (J.EQ.3) I=5
-CALL FOO(I)
-END
-@end example
-
-@noindent
-If the value of @code{J} is always 1, 2 or 3, then @code{I} is
-always initialized, but GNU Fortran doesn't know this.  Here is
-another common case:
-
-@example
-SUBROUTINE MAYBE(FLAG)
-LOGICAL FLAG
-IF (FLAG) VALUE = 9.4
-@dots{}
-IF (FLAG) PRINT *, VALUE
-END
-@end example
-
-@noindent
-This has no bug because @code{VALUE} is used only if it is set.
-
-@cindex -Wall option
-@cindex options, -Wall
-@item -Wall
-@cindex all warnings
-@cindex warnings, all
-The @option{-Wunused} and @option{-Wuninitialized} options combined.
-These are all the
-options which pertain to usage that we recommend avoiding and that we
-believe is easy to avoid.
-(As more warnings are added to @command{g77} some might
-be added to the list enabled by @option{-Wall}.)
-@end table
-
-The remaining @option{-W@dots{}} options are not implied by @option{-Wall}
-because they warn about constructions that we consider reasonable to
-use, on occasion, in clean programs.
-
-@table @gcctabopt
-@c @item -W
-@c Print extra warning messages for these events:
-@c
-@c @itemize @bullet
-@c @item
-@c If @option{-Wall} or @option{-Wunused} is also specified, warn about unused
-@c arguments.
-@c
-@c @end itemize
-@c
-@cindex -Wsurprising option
-@cindex options, -Wsurprising
-@item -Wsurprising
-Warn about ``suspicious'' constructs that are interpreted
-by the compiler in a way that might well be surprising to
-someone reading the code.
-These differences can result in subtle, compiler-dependent
-(even machine-dependent) behavioral differences.
-The constructs warned about include:
-
-@itemize @bullet
-@item
-Expressions having two arithmetic operators in a row, such
-as @samp{X*-Y}.
-Such a construct is nonstandard, and can produce
-unexpected results in more complicated situations such
-as @samp{X**-Y*Z}.
-@command{g77} along with many other compilers, interprets
-this example differently than many programmers, and a few
-other compilers.
-Specifically, @command{g77} interprets @samp{X**-Y*Z} as
-@samp{(X**(-Y))*Z}, while others might think it should
-be interpreted as @samp{X**(-(Y*Z))}.
-
-A revealing example is the constant expression @samp{2**-2*1.},
-which @command{g77} evaluates to .25, while others might evaluate
-it to 0., the difference resulting from the way precedence affects
-type promotion.
-
-(The @option{-fpedantic} option also warns about expressions
-having two arithmetic operators in a row.)
-
-@item
-Expressions with a unary minus followed by an operand and then
-a binary operator other than plus or minus.
-For example, @samp{-2**2} produces a warning, because
-the precedence is @samp{-(2**2)}, yielding -4, not
-@samp{(-2)**2}, which yields 4, and which might represent
-what a programmer expects.
-
-An example of an expression producing different results
-in a surprising way is @samp{-I*S}, where @var{I} holds
-the value @samp{-2147483648} and @var{S} holds @samp{0.5}.
-On many systems, negating @var{I} results in the same
-value, not a positive number, because it is already the
-lower bound of what an @code{INTEGER(KIND=1)} variable can hold.
-So, the expression evaluates to a positive number, while
-the ``expected'' interpretation, @samp{(-I)*S}, would
-evaluate to a negative number.
-
-Even cases such as @samp{-I*J} produce warnings,
-even though, in most configurations and situations,
-there is no computational difference between the
-results of the two interpretations---the purpose
-of this warning is to warn about differing interpretations
-and encourage a better style of coding, not to identify
-only those places where bugs might exist in the user's
-code.
-
-@cindex DO statement
-@cindex statements, DO
-@item
-@code{DO} loops with @code{DO} variables that are not
-of integral type---that is, using @code{REAL}
-variables as loop control variables.
-Although such loops can be written to work in the
-``obvious'' way, the way @command{g77} is required by the
-Fortran standard to interpret such code is likely to
-be quite different from the way many programmers expect.
-(This is true of all @code{DO} loops, but the differences
-are pronounced for non-integral loop control variables.)
-
-@xref{Loops}, for more information.
-@end itemize
-
-@cindex -Werror option
-@cindex options, -Werror
-@item -Werror
-Make all warnings into errors.
-
-@cindex -W option
-@cindex options, -W
-@item -W
-@cindex extra warnings
-@cindex warnings, extra
-Turns on ``extra warnings'' and, if optimization is specified
-via @option{-O}, the @option{-Wuninitialized} option.
-(This might change in future versions of @command{g77}
-
-``Extra warnings'' are issued for:
-
-@itemize @bullet
-@item
-@cindex unused parameters
-@cindex parameters, unused
-@cindex unused arguments
-@cindex arguments, unused
-@cindex unused dummies
-@cindex dummies, unused
-Unused parameters to a procedure (when @option{-Wunused} also is
-specified).
-
-@item
-@cindex overflow
-Overflows involving floating-point constants (not available
-for certain configurations).
-@end itemize
-@end table
-
-@xref{Warning Options,,Options to Request or Suppress Warnings,
-gcc,Using the GNU Compiler Collection (GCC)}, for information on more
-options offered
-by the GBE shared by @command{g77} @command{gcc} and other GNU compilers.
-
-Some of these have no effect when compiling programs written in Fortran:
-
-@table @gcctabopt
-@cindex -Wcomment option
-@cindex options, -Wcomment
-@item -Wcomment
-@cindex -Wformat option
-@cindex options, -Wformat
-@item -Wformat
-@cindex -Wparentheses option
-@cindex options, -Wparentheses
-@item -Wparentheses
-@cindex -Wswitch option
-@cindex options, -Wswitch
-@item -Wswitch
-@cindex -Wswitch-default option
-@cindex options, -Wswitch-default
-@item -Wswitch-default
-@cindex -Wswitch-enum option
-@cindex options, -Wswitch-enum
-@item -Wswitch-enum
-@cindex -Wtraditional option
-@cindex options, -Wtraditional
-@item -Wtraditional
-@cindex -Wshadow option
-@cindex options, -Wshadow
-@item -Wshadow
-@cindex -Wid-clash-@var{len} option
-@cindex options, -Wid-clash-@var{len}
-@item -Wid-clash-@var{len}
-@cindex -Wlarger-than-@var{len} option
-@cindex options, -Wlarger-than-@var{len}
-@item -Wlarger-than-@var{len}
-@cindex -Wconversion option
-@cindex options, -Wconversion
-@item -Wconversion
-@cindex -Waggregate-return option
-@cindex options, -Waggregate-return
-@item -Waggregate-return
-@cindex -Wredundant-decls option
-@cindex options, -Wredundant-decls
-@item -Wredundant-decls
-@cindex unsupported warnings
-@cindex warnings, unsupported
-These options all could have some relevant meaning for
-GNU Fortran programs, but are not yet supported.
-@end table
-
-@node Debugging Options
-@section Options for Debugging Your Program or GNU Fortran
-@cindex options, debugging
-@cindex debugging information options
-
-GNU Fortran has various special options that are used for debugging
-either your program or @command{g77}
-
-@table @gcctabopt
-@cindex -g option
-@cindex options, -g
-@item -g
-Produce debugging information in the operating system's native format
-(stabs, COFF, XCOFF, or DWARF).  GDB can work with this debugging
-information.
-
-A sample debugging session looks like this (note the use of the breakpoint):
-@smallexample
-$ cat gdb.f
-      PROGRAM PROG
-      DIMENSION A(10)
-      DATA A /1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
-      A(5) = 4.
-      PRINT*,A
-      END
-$ g77 -g -O gdb.f
-$ gdb a.out
-...
-(gdb) break MAIN__ 
-Breakpoint 1 at 0x8048e96: file gdb.f, line 4.
-(gdb) run
-Starting program: /home/toon/g77-bugs/./a.out 
-Breakpoint 1, MAIN__ () at gdb.f:4
-4             A(5) = 4.
-Current language:  auto; currently fortran
-(gdb) print a(5)
-$1 = 5
-(gdb) step 
-5             PRINT*,A
-(gdb) print a(5)
-$2 = 4
-...
-@end smallexample
-One could also add the setting of the breakpoint and the first run command
-to the file @file{.gdbinit} in the current directory, to simplify the debugging
-session.
-@end table
-
-@xref{Debugging Options,,Options for Debugging Your Program or GCC,
-gcc,Using the GNU Compiler Collection (GCC)}, for more information on
-debugging options.
-
-@node Optimize Options
-@section Options That Control Optimization
-@cindex optimize options
-@cindex options, optimization
-
-Most Fortran users will want to use no optimization when
-developing and testing programs, and use @option{-O} or @option{-O2} when
-compiling programs for late-cycle testing and for production use.
-However, note that certain diagnostics---such as for uninitialized
-variables---depend on the flow analysis done by @option{-O}, i.e.@: you
-must use @option{-O} or @option{-O2} to get such diagnostics.
-
-The following flags have particular applicability when
-compiling Fortran programs:
-
-@table @gcctabopt
-@cindex -malign-double option
-@cindex options, -malign-double
-@item -malign-double
-(Intel x86 architecture only.)
-
-Noticeably improves performance of @command{g77} programs making
-heavy use of @code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data
-on some systems.
-In particular, systems using Pentium, Pentium Pro, 586, and
-686 implementations
-of the i386 architecture execute programs faster when
-@code{REAL(KIND=2)} (@code{DOUBLE PRECISION}) data are
-aligned on 64-bit boundaries
-in memory.
-
-This option can, at least, make benchmark results more consistent
-across various system configurations, versions of the program,
-and data sets.
-
-@emph{Note:} The warning in the @command{gcc} documentation about
-this option does not apply, generally speaking, to Fortran
-code compiled by @command{g77}
-
-@xref{Aligned Data}, for more information on alignment issues.
-
-@emph{Also also note:} The negative form of @option{-malign-double}
-is @option{-mno-align-double}, not @option{-benign-double}.
-
-@cindex -ffloat-store option
-@cindex options, -ffloat-store
-@item -ffloat-store
-@cindex IEEE 754 conformance
-@cindex conformance, IEEE 754
-@cindex floating-point, precision
-Might help a Fortran program that depends on exact IEEE conformance on
-some machines, but might slow down a program that doesn't.
-
-This option is effective when the floating-point unit is set to work in
-IEEE 854 `extended precision'---as it typically is on x86 and m68k GNU
-systems---rather than IEEE 754 double precision.  @option{-ffloat-store}
-tries to remove the extra precision by spilling data from floating-point
-registers into memory and this typically involves a big performance
-hit.  However, it doesn't affect intermediate results, so that it is
-only partially effective.  `Excess precision' is avoided in code like:
-@smallexample
-a = b + c
-d = a * e
-@end smallexample
-but not in code like:
-@smallexample
-      d = (b + c) * e
-@end smallexample
-
-For another, potentially better, way of controlling the precision,
-see @ref{Floating-point precision}.
-
-@cindex -fforce-mem option
-@cindex options, -fforce-mem
-@item -fforce-mem
-@cindex -fforce-addr option
-@cindex options, -fforce-addr
-@item -fforce-addr
-@cindex loops, speeding up
-@cindex speed, of loops
-Might improve optimization of loops.
-
-@cindex -fno-inline option
-@cindex options, -fno-inline
-@item -fno-inline
-@cindex in-line code
-@cindex compilation, in-line
-@c DL: Only relevant for -O3? TM: No, statement functions are
-@c inlined even at -O1.
-Don't compile statement functions inline.
-Might reduce the size of a program unit---which might be at
-expense of some speed (though it should compile faster).
-Note that if you are not optimizing, no functions can be expanded inline.
-
-@cindex -ffast-math option
-@cindex options, -ffast-math
-@item -ffast-math
-@cindex IEEE 754 conformance
-@cindex conformance, IEEE 754
-Might allow some programs designed to not be too dependent
-on IEEE behavior for floating-point to run faster, or die trying.
-Sets @option{-funsafe-math-optimizations}, @option{-ffinite-math-only},
-and @option{-fno-trapping-math}.
-
-@cindex -funsafe-math-optimizations option
-@cindex options, -funsafe-math-optimizations
-@item -funsafe-math-optimizations
-Allow optimizations that may be give incorrect results
-for certain IEEE inputs.
-
-@cindex -ffinite-math-only option
-@cindex options, -ffinite-math-only
-@item -ffinite-math-only
-Allow optimizations for floating-point arithmetic that assume
-that arguments and results are not NaNs or +-Infs.
-
-This option should never be turned on by any @option{-O} option since
-it can result in incorrect output for programs which depend on
-an exact implementation of IEEE or ISO rules/specifications.
-
-The default is @option{-fno-finite-math-only}.
-
-@cindex -fno-trapping-math option
-@cindex options, -fno-trapping-math
-@item -fno-trapping-math
-Allow the compiler to assume that floating-point arithmetic
-will not generate traps on any inputs.  This is useful, for
-example, when running a program using IEEE "non-stop"
-floating-point arithmetic.
-
-@cindex -fstrength-reduce option
-@cindex options, -fstrength-reduce
-@item -fstrength-reduce
-@cindex loops, speeding up
-@cindex speed, of loops
-@c DL: normally defaulted?
-Might make some loops run faster.
-
-@cindex -frerun-cse-after-loop option
-@cindex options, -frerun-cse-after-loop
-@item -frerun-cse-after-loop
-@cindex -fexpensive-optimizations option
-@cindex options, -fexpensive-optimizations
-@c DL: This is -O2?
-@item -fexpensive-optimizations
-@cindex -fdelayed-branch option
-@cindex options, -fdelayed-branch
-@item -fdelayed-branch
-@cindex -fschedule-insns option
-@cindex options, -fschedule-insns
-@item -fschedule-insns
-@cindex -fschedule-insns2 option
-@cindex options, -fschedule-insns2
-@item -fschedule-insns2
-@cindex -fcaller-saves option
-@cindex options, -fcaller-saves
-@item -fcaller-saves
-Might improve performance on some code.
-
-@cindex -funroll-loops option
-@cindex options, -funroll-loops
-@item -funroll-loops
-@cindex loops, unrolling
-@cindex unrolling loops
-@cindex loops, optimizing
-@cindex indexed (iterative) @code{DO}
-@cindex iterative @code{DO}
-@c DL: fixme: Craig doesn't like `indexed' but f95 doesn't seem to
-@c provide a suitable term
-@c CB: I've decided on `iterative', for the time being, and changed
-@c my previous, rather bizarre, use of `imperative' to that
-@c (though `precomputed-trip' would be a more precise adjective)
-Typically improves performance on code using iterative @code{DO} loops by
-unrolling them and is probably generally appropriate for Fortran, though
-it is not turned on at any optimization level.
-Note that outer loop unrolling isn't done specifically; decisions about
-whether to unroll a loop are made on the basis of its instruction count.
-
-@c DL: Fixme: This should obviously go somewhere else...
-Also, no `loop discovery'@footnote{@dfn{loop discovery} refers to the
-process by which a compiler, or indeed any reader of a program,
-determines which portions of the program are more likely to be executed
-repeatedly as it is being run.  Such discovery typically is done early
-when compiling using optimization techniques, so the ``discovered''
-loops get more attention---and more run-time resources, such as
-registers---from the compiler.  It is easy to ``discover'' loops that are
-constructed out of looping constructs in the language
-(such as Fortran's @code{DO}).  For some programs, ``discovering'' loops
-constructed out of lower-level constructs (such as @code{IF} and
-@code{GOTO}) can lead to generation of more optimal code
-than otherwise.} is done, so only loops written with @code{DO}
-benefit from loop optimizations, including---but not limited
-to---unrolling.  Loops written with @code{IF} and @code{GOTO} are not
-currently recognized as such.  This option unrolls only iterative
-@code{DO} loops, not @code{DO WHILE} loops.
-
-@cindex -funroll-all-loops option
-@cindex options, -funroll-all-loops
-@cindex DO WHILE
-@item -funroll-all-loops
-@c DL: Check my understanding of -funroll-all-loops v. -funroll-loops is correct.
-Probably improves performance on code using @code{DO WHILE} loops by
-unrolling them in addition to iterative @code{DO} loops.  In the absence
-of @code{DO WHILE}, this option is equivalent to @option{-funroll-loops}
-but possibly slower.
-
-@item -fno-move-all-movables
-@cindex -fno-move-all-movables option
-@cindex options, -fno-move-all-movables
-@item -fno-reduce-all-givs
-@cindex -fno-reduce-all-givs option
-@cindex options, -fno-reduce-all-givs
-@item -fno-rerun-loop-opt
-@cindex -fno-rerun-loop-opt option
-@cindex options, -fno-rerun-loop-opt
-In general, the optimizations enabled with these options will lead to
-faster code being generated by GNU Fortran; hence they are enabled by default
-when issuing the @command{g77} command.
-
-@option{-fmove-all-movables} and @option{-freduce-all-givs} will enable
-loop optimization to move all loop-invariant index computations in nested
-loops over multi-rank array dummy arguments out of these loops.
-
-@option{-frerun-loop-opt} will move offset calculations resulting
-from the fact that Fortran arrays by default have a lower bound of 1
-out of the loops.
-
-These three options are intended to be removed someday, once
-loop optimization is sufficiently advanced to perform all those
-transformations without help from these options.
-@end table
-
-@xref{Optimize Options,,Options That Control Optimization,
-gcc,Using the GNU Compiler Collection (GCC)}, for more information on options
-to optimize the generated machine code.
-
-@node Preprocessor Options
-@section Options Controlling the Preprocessor
-@cindex preprocessor options
-@cindex options, preprocessor
-@cindex cpp program
-@cindex programs, cpp
-
-These options control the C preprocessor, which is run on each C source
-file before actual compilation.
-
-@xref{Preprocessor Options,,Options Controlling the Preprocessor,
-gcc,Using the GNU Compiler Collection (GCC)}, for information on C
-preprocessor options.
-
-@cindex INCLUDE directive
-@cindex directive, INCLUDE
-Some of these options also affect how @command{g77} processes the
-@code{INCLUDE} directive.
-Since this directive is processed even when preprocessing
-is not requested, it is not described in this section.
-@xref{Directory Options,,Options for Directory Search}, for
-information on how @command{g77} processes the @code{INCLUDE} directive.
-
-However, the @code{INCLUDE} directive does not apply
-preprocessing to the contents of the included file itself.
-
-Therefore, any file that contains preprocessor directives
-(such as @code{#include}, @code{#define}, and @code{#if})
-must be included via the @code{#include} directive, not
-via the @code{INCLUDE} directive.
-Therefore, any file containing preprocessor directives,
-if included, is necessarily included by a file that itself
-contains preprocessor directives.
-
-@node Directory Options
-@section Options for Directory Search
-@cindex directory, options
-@cindex options, directory search
-@cindex search path
-
-These options affect how the @command{cpp} preprocessor searches
-for files specified via the @code{#include} directive.
-Therefore, when compiling Fortran programs, they are meaningful
-when the preprocessor is used.
-
-@cindex INCLUDE directive
-@cindex directive, INCLUDE
-Some of these options also affect how @command{g77} searches
-for files specified via the @code{INCLUDE} directive,
-although files included by that directive are not,
-themselves, preprocessed.
-These options are:
-
-@table @gcctabopt
-@cindex -I- option
-@cindex options, -I-
-@item -I-
-@cindex -Idir option
-@cindex options, -Idir
-@item -I@var{dir}
-@cindex directory, search paths for inclusion
-@cindex inclusion, directory search paths for
-@cindex search paths, for included files
-@cindex paths, search
-These affect interpretation of the @code{INCLUDE} directive
-(as well as of the @code{#include} directive of the @command{cpp}
-preprocessor).
-
-Note that @option{-I@var{dir}} must be specified @emph{without} any
-spaces between @option{-I} and the directory name---that is,
-@option{-Ifoo/bar} is valid, but @option{-I foo/bar}
-is rejected by the @command{g77} compiler (though the preprocessor supports
-the latter form).
-@c this is due to toplev.c's inflexible option processing
-Also note that the general behavior of @option{-I} and
-@code{INCLUDE} is pretty much the same as of @option{-I} with
-@code{#include} in the @command{cpp} preprocessor, with regard to
-looking for @file{header.gcc} files and other such things.
-
-@xref{Directory Options,,Options for Directory Search,
-gcc,Using the GNU Compiler Collection (GCC)}, for information on the
-@option{-I} option.
-@end table
-
-@node Code Gen Options
-@section Options for Code Generation Conventions
-@cindex code generation, conventions
-@cindex options, code generation
-@cindex run-time, options
-
-These machine-independent options control the interface conventions
-used in code generation.
-
-Most of them have both positive and negative forms; the negative form
-of @option{-ffoo} would be @option{-fno-foo}.  In the table below, only
-one of the forms is listed---the one which is not the default.  You
-can figure out the other form by either removing @option{no-} or adding
-it.
-
-@table @gcctabopt
-@cindex -fno-automatic option
-@cindex options, -fno-automatic
-@item -fno-automatic
-@cindex SAVE statement
-@cindex statements, SAVE
-Treat each program unit as if the @code{SAVE} statement was specified
-for every local variable and array referenced in it.
-Does not affect common blocks.
-(Some Fortran compilers provide this option under
-the name @option{-static}.)
-
-@cindex -finit-local-zero option
-@cindex options, -finit-local-zero
-@item -finit-local-zero
-@cindex DATA statement
-@cindex statements, DATA
-@cindex initialization, of local variables
-@cindex variables, initialization of
-@cindex uninitialized variables
-@cindex variables, uninitialized
-Specify that variables and arrays that are local to a program unit
-(not in a common block and not passed as an argument) are to be initialized
-to binary zeros.
-
-Since there is a run-time penalty for initialization of variables
-that are not given the @code{SAVE} attribute, it might be a
-good idea to also use @option{-fno-automatic} with @option{-finit-local-zero}.
-
-@cindex -fno-f2c option
-@cindex options, -fno-f2c
-@item -fno-f2c
-@cindex @command{f2c} compatibility
-@cindex compatibility, @command{f2c}
-Do not generate code designed to be compatible with code generated
-by @command{f2c} use the GNU calling conventions instead.
-
-The @command{f2c} calling conventions require functions that return
-type @code{REAL(KIND=1)} to actually return the C type @code{double},
-and functions that return type @code{COMPLEX} to return the
-values via an extra argument in the calling sequence that points
-to where to store the return value.
-Under the GNU calling conventions, such functions simply return
-their results as they would in GNU C---@code{REAL(KIND=1)} functions
-return the C type @code{float}, and @code{COMPLEX} functions
-return the GNU C type @code{complex} (or its @code{struct}
-equivalent).
-
-This does not affect the generation of code that interfaces with the
-@code{libg2c} library.
-
-However, because the @code{libg2c} library uses @command{f2c}
-calling conventions, @command{g77} rejects attempts to pass
-intrinsics implemented by routines in this library as actual
-arguments when @option{-fno-f2c} is used, to avoid bugs when
-they are actually called by code expecting the GNU calling
-conventions to work.
-
-For example, @samp{INTRINSIC ABS;CALL FOO(ABS)} is
-rejected when @option{-fno-f2c} is in force.
-(Future versions of the @command{g77} run-time library might
-offer routines that provide GNU-callable versions of the
-routines that implement the @command{f2c} intrinsics
-that may be passed as actual arguments, so that
-valid programs need not be rejected when @option{-fno-f2c}
-is used.)
-
-@strong{Caution:} If @option{-fno-f2c} is used when compiling any
-source file used in a program, it must be used when compiling
-@emph{all} Fortran source files used in that program.
-
-@c seems kinda dumb to tell people about an option they can't use -- jcb
-@c then again, we want users building future-compatible libraries with it.
-@cindex -ff2c-library option
-@cindex options, -ff2c-library
-@item -ff2c-library
-Specify that use of @code{libg2c} (or the original @code{libf2c})
-is required.
-This is the default for the current version of @command{g77}
-
-Currently it is not
-valid to specify @option{-fno-f2c-library}.
-This option is provided so users can specify it in shell
-scripts that build programs and libraries that require the
-@code{libf2c} library, even when being compiled by future
-versions of @command{g77} that might otherwise default to
-generating code for an incompatible library.
-
-@cindex -fno-underscoring option
-@cindex options, -fno-underscoring
-@item -fno-underscoring
-@cindex underscore
-@cindex symbol names, underscores
-@cindex transforming symbol names
-@cindex symbol names, transforming
-Do not transform names of entities specified in the Fortran
-source file by appending underscores to them.
-
-With @option{-funderscoring} in effect, @command{g77} appends two underscores
-to names with underscores and one underscore to external names with
-no underscores.  (@command{g77} also appends two underscores to internal
-names with underscores to avoid naming collisions with external names.
-The @option{-fno-second-underscore} option disables appending of the
-second underscore in all cases.)
-
-This is done to ensure compatibility with code produced by many
-UNIX Fortran compilers, including @command{f2c} which perform the
-same transformations.
-
-Use of @option{-fno-underscoring} is not recommended unless you are
-experimenting with issues such as integration of (GNU) Fortran into
-existing system environments (vis-a-vis existing libraries, tools, and
-so on).
-
-For example, with @option{-funderscoring}, and assuming other defaults like
-@option{-fcase-lower} and that @samp{j()} and @samp{max_count()} are
-external functions while @samp{my_var} and @samp{lvar} are local variables,
-a statement like
-
-@smallexample
-I = J() + MAX_COUNT (MY_VAR, LVAR)
-@end smallexample
-
-@noindent
-is implemented as something akin to:
-
-@smallexample
-i = j_() + max_count__(&my_var__, &lvar);
-@end smallexample
-
-With @option{-fno-underscoring}, the same statement is implemented as:
-
-@smallexample
-i = j() + max_count(&my_var, &lvar);
-@end smallexample
-
-Use of @option{-fno-underscoring} allows direct specification of
-user-defined names while debugging and when interfacing @command{g77}
-code with other languages.
-
-Note that just because the names match does @emph{not} mean that the
-interface implemented by @command{g77} for an external name matches the
-interface implemented by some other language for that same name.
-That is, getting code produced by @command{g77} to link to code produced
-by some other compiler using this or any other method can be only a
-small part of the overall solution---getting the code generated by
-both compilers to agree on issues other than naming can require
-significant effort, and, unlike naming disagreements, linkers normally
-cannot detect disagreements in these other areas.
-
-Also, note that with @option{-fno-underscoring}, the lack of appended
-underscores introduces the very real possibility that a user-defined
-external name will conflict with a name in a system library, which
-could make finding unresolved-reference bugs quite difficult in some
-cases---they might occur at program run time, and show up only as
-buggy behavior at run time.
-
-In future versions of @command{g77} we hope to improve naming and linking
-issues so that debugging always involves using the names as they appear
-in the source, even if the names as seen by the linker are mangled to
-prevent accidental linking between procedures with incompatible
-interfaces.
-
-@cindex -fno-second-underscore option
-@cindex options, -fno-second-underscore
-@item -fno-second-underscore
-@cindex underscore
-@cindex symbol names, underscores
-@cindex transforming symbol names
-@cindex symbol names, transforming
-Do not append a second underscore to names of entities specified
-in the Fortran source file.
-
-This option has no effect if @option{-fno-underscoring} is
-in effect.
-
-Otherwise, with this option, an external name such as @samp{MAX_COUNT}
-is implemented as a reference to the link-time external symbol
-@samp{max_count_}, instead of @samp{max_count__}.
-
-@cindex -fno-ident option
-@cindex options, -fno-ident
-@item -fno-ident
-Ignore the @samp{#ident} directive.
-
-@cindex -fzeros option
-@cindex options, -fzeros
-@item -fzeros
-Treat initial values of zero as if they were any other value.
-
-As of version 0.5.18, @command{g77} normally treats @code{DATA} and
-other statements that are used to specify initial values of zero
-for variables and arrays as if no values were actually specified,
-in the sense that no diagnostics regarding multiple initializations
-are produced.
-
-This is done to speed up compiling of programs that initialize
-large arrays to zeros.
-
-Use @option{-fzeros} to revert to the simpler, slower behavior
-that can catch multiple initializations by keeping track of
-all initializations, zero or otherwise.
-
-@emph{Caution:} Future versions of @command{g77} might disregard this option
-(and its negative form, the default) or interpret it somewhat
-differently.
-The interpretation changes will affect only non-standard
-programs; standard-conforming programs should not be affected.
-
-@cindex -femulate-complex option
-@cindex options, -femulate-complex
-@item -femulate-complex
-Implement @code{COMPLEX} arithmetic via emulation,
-instead of using the facilities of
-the @command{gcc} back end that provide direct support of
-@code{complex} arithmetic.
-
-(@command{gcc} had some bugs in its back-end support
-for @code{complex} arithmetic, due primarily to the support not being
-completed as of version 2.8.1 and @code{egcs} 1.1.2.)
-
-Use @option{-femulate-complex} if you suspect code-generation bugs,
-or experience compiler crashes,
-that might result from @command{g77} using the @code{COMPLEX} support
-in the @command{gcc} back end.
-If using that option fixes the bugs or crashes you are seeing,
-that indicates a likely @command{g77} bugs
-(though, all compiler crashes are considered bugs),
-so, please report it.
-(Note that the known bugs, now believed fixed, produced compiler crashes
-rather than causing the generation of incorrect code.)
-
-Use of this option should not affect how Fortran code compiled
-by @command{g77} works in terms of its interfaces to other code,
-e.g. that compiled by @command{f2c}
-
-As of GCC version 3.0, this option is not necessary anymore.
-
-@emph{Caution:} Future versions of @command{g77} might ignore both forms
-of this option.
-
-@cindex -falias-check option
-@cindex options, -falias-check
-@cindex -fargument-alias option
-@cindex options, -fargument-alias
-@cindex -fargument-noalias option
-@cindex options, -fargument-noalias
-@cindex -fno-argument-noalias-global option
-@cindex options, -fno-argument-noalias-global
-@item -falias-check
-@item -fargument-alias
-@item -fargument-noalias
-@item -fno-argument-noalias-global
-@emph{Version info:}
-These options are not supported by
-versions of @command{g77} based on @command{gcc} version 2.8.
-
-These options specify to what degree aliasing
-(overlap)
-is permitted between
-arguments (passed as pointers) and @code{COMMON} (external, or
-public) storage.
-
-The default for Fortran code, as mandated by the FORTRAN 77 and
-Fortran 90 standards, is @option{-fargument-noalias-global}.
-The default for code written in the C language family is
-@option{-fargument-alias}.
-
-Note that, on some systems, compiling with @option{-fforce-addr} in
-effect can produce more optimal code when the default aliasing
-options are in effect (and when optimization is enabled).
-
-@xref{Aliasing Assumed To Work}, for detailed information on the implications
-of compiling Fortran code that depends on the ability to alias dummy
-arguments.
-
-@cindex -fno-globals option
-@cindex options, -fno-globals
-@item -fno-globals
-@cindex global names, warning
-@cindex warnings, global names
-@cindex in-line code
-@cindex compilation, in-line
-Disable diagnostics about inter-procedural
-analysis problems, such as disagreements about the
-type of a function or a procedure's argument,
-that might cause a compiler crash when attempting
-to inline a reference to a procedure within a
-program unit.
-(The diagnostics themselves are still produced, but
-as warnings, unless @option{-Wno-globals} is specified,
-in which case no relevant diagnostics are produced.)
-
-Further, this option disables such inlining, to
-avoid compiler crashes resulting from incorrect
-code that would otherwise be diagnosed.
-
-As such, this option might be quite useful when
-compiling existing, ``working'' code that happens
-to have a few bugs that do not generally show themselves,
-but which @command{g77} diagnoses.
-
-Use of this option therefore has the effect of
-instructing @command{g77} to behave more like it did
-up through version 0.5.19.1, when it paid little or
-no attention to disagreements between program units
-about a procedure's type and argument information,
-and when it performed no inlining of procedures
-(except statement functions).
-
-Without this option, @command{g77} defaults to performing
-the potentially inlining procedures as it started doing
-in version 0.5.20, but as of version 0.5.21, it also
-diagnoses disagreements that might cause such inlining
-to crash the compiler as (fatal) errors,
-and warns about similar disagreements
-that are currently believed to not
-likely to result in the compiler later crashing
-or producing incorrect code.
-
-@cindex -fflatten-arrays option
-@item -fflatten-arrays
-@cindex array performance
-@cindex arrays, flattening
-Use back end's C-like constructs
-(pointer plus offset)
-instead of its @code{ARRAY_REF} construct
-to handle all array references.
-
-@emph{Note:} This option is not supported.
-It is intended for use only by @command{g77} developers,
-to evaluate code-generation issues.
-It might be removed at any time.
-
-@cindex -fbounds-check option
-@cindex -ffortran-bounds-check option
-@item -fbounds-check
-@itemx -ffortran-bounds-check
-@cindex bounds checking
-@cindex range checking
-@cindex array bounds checking
-@cindex subscript checking
-@cindex substring checking
-@cindex checking subscripts
-@cindex checking substrings
-Enable generation of run-time checks for array subscripts
-and substring start and end points
-against the (locally) declared minimum and maximum values.
-
-The current implementation uses the @code{libf2c}
-library routine @code{s_rnge} to print the diagnostic.
-
-However, whereas @command{f2c} generates a single check per
-reference for a multi-dimensional array, of the computed
-offset against the valid offset range (0 through the size of the array),
-@command{g77} generates a single check per @emph{subscript} expression.
-This catches some cases of potential bugs that @command{f2c} does not,
-such as references to below the beginning of an assumed-size array.
-
-@command{g77} also generates checks for @code{CHARACTER} substring references,
-something @command{f2c} currently does not do.
-
-Use the new @option{-ffortran-bounds-check} option
-to specify bounds-checking for only the Fortran code you are compiling,
-not necessarily for code written in other languages.
-
-@emph{Note:} To provide more detailed information on the offending subscript,
-@command{g77} provides the @code{libg2c} run-time library routine @code{s_rnge}
-with somewhat differently-formatted information.
-Here's a sample diagnostic:
-
-@smallexample
-Subscript out of range on file line 4, procedure rnge.f/bf.
-Attempt to access the -6-th element of variable b[subscript-2-of-2].
-Aborted
-@end smallexample
-
-The above message indicates that the offending source line is
-line 4 of the file @file{rnge.f},
-within the program unit (or statement function) named @samp{bf}.
-The offended array is named @samp{b}.
-The offended array dimension is the second for a two-dimensional array,
-and the offending, computed subscript expression was @samp{-6}.
-
-For a @code{CHARACTER} substring reference, the second line has
-this appearance:
-
-@smallexample
-Attempt to access the 11-th element of variable a[start-substring].
-@end smallexample
-
-This indicates that the offended @code{CHARACTER} variable or array
-is named @samp{a},
-the offended substring position is the starting (leftmost) position,
-and the offending substring expression is @samp{11}.
-
-(Though the verbage of @code{s_rnge} is not ideal
-for the purpose of the @command{g77} compiler,
-the above information should provide adequate diagnostic abilities
-to it users.)
-@end table
-
-@xref{Code Gen Options,,Options for Code Generation Conventions,
-gcc,Using the GNU Compiler Collection (GCC)}, for information on more options
-offered by the GBE
-shared by @command{g77} @command{gcc} and other GNU compilers.
-
-Some of these do @emph{not} work when compiling programs written in Fortran:
-
-@table @gcctabopt
-@cindex -fpcc-struct-return option
-@cindex options, -fpcc-struct-return
-@item -fpcc-struct-return
-@cindex -freg-struct-return option
-@cindex options, -freg-struct-return
-@item -freg-struct-return
-You should not use these except strictly the same way as you
-used them to build the version of @code{libg2c} with which
-you will be linking all code compiled by @command{g77} with the
-same option.
-
-@cindex -fshort-double option
-@cindex options, -fshort-double
-@item -fshort-double
-This probably either has no effect on Fortran programs, or
-makes them act loopy.
-
-@cindex -fno-common option
-@cindex options, -fno-common
-@item -fno-common
-Do not use this when compiling Fortran programs,
-or there will be Trouble.
-
-@cindex -fpack-struct option
-@cindex options, -fpack-struct
-@item -fpack-struct
-This probably will break any calls to the @code{libg2c} library,
-at the very least, even if it is built with the same option.
-@end table
-
-@c man end
-
-@node Environment Variables
-@section Environment Variables Affecting GNU Fortran
-@cindex environment variables
-
-@c man begin ENVIRONMENT
-
-GNU Fortran currently does not make use of any environment
-variables to control its operation above and beyond those
-that affect the operation of @command{gcc}.
-
-@xref{Environment Variables,,Environment Variables Affecting GCC,
-gcc,Using the GNU Compiler Collection (GCC)}, for information on environment
-variables.
-
-@c man end
diff --git a/gcc/f/lab.c b/gcc/f/lab.c
deleted file mode 100644
index 1d27874..0000000
--- a/gcc/f/lab.c
+++ /dev/null
@@ -1,157 +0,0 @@
-/* lab.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-
-   Description:
-      Complex data abstraction for Fortran labels.  Maintains a single master
-      list for all labels; it is expected initialization and termination of
-      this list will occur on program-unit boundaries.
-
-   Modifications:
-      22-Aug-89	 JCB  1.1
-	 Change ffelab_new for new ffewhere interface.
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "lab.h"
-#include "malloc.h"
-
-/* Externals defined here. */
-
-ffelab ffelab_list_;
-ffelabNumber ffelab_num_news_;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffelab_find -- Find the ffelab object having the desired label value
-
-   ffelab l;
-   ffelabValue v;
-   l = ffelab_find(v);
-
-   If the desired ffelab object doesn't exist, returns NULL.
-
-   Straightforward search of list of ffelabs.  */
-
-ffelab
-ffelab_find (ffelabValue v)
-{
-  ffelab l;
-
-  for (l = ffelab_list_; (l != NULL) && (ffelab_value (l) != v); l = l->next)
-    ;
-
-  return l;
-}
-
-/* ffelab_finish -- Shut down label management
-
-   ffelab_finish();
-
-   At the end of processing a program unit, call this routine to shut down
-   label management.
-
-   Kill all the labels on the list.  */
-
-void
-ffelab_finish (void)
-{
-  ffelab l;
-  ffelab pl;
-
-  for (pl = NULL, l = ffelab_list_; l != NULL; pl = l, l = l->next)
-    if (pl != NULL)
-      malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
-
-  if (pl != NULL)
-    malloc_kill_ks (ffe_pool_any_unit (), pl, sizeof (*pl));
-}
-
-/* ffelab_init_3 -- Initialize label management system
-
-   ffelab_init_3();
-
-   Initialize the label management system.  Do this before a new program
-   unit is going to be processed.  */
-
-void
-ffelab_init_3 (void)
-{
-  ffelab_list_ = NULL;
-  ffelab_num_news_ = 0;
-}
-
-/* ffelab_new -- Create an ffelab object.
-
-   ffelab l;
-   ffelabValue v;
-   l = ffelab_new(v);
-
-   Create a label having a given value.	 If the value isn't known, pass
-   FFELAB_valueNONE, and set it later with ffelab_set_value.
-
-   Allocate, initialize, and stick at top of label list.
-
-   22-Aug-89  JCB  1.1
-      Change for new ffewhere interface.  */
-
-ffelab
-ffelab_new (ffelabValue v)
-{
-  ffelab l;
-
-  ++ffelab_num_news_;
-  l = malloc_new_ks (ffe_pool_any_unit (), "FFELAB label", sizeof (*l));
-  l->next = ffelab_list_;
-  l->hook = FFECOM_labelNULL;
-  l->value = v;
-  l->firstref_line = ffewhere_line_unknown ();
-  l->firstref_col = ffewhere_column_unknown ();
-  l->doref_line = ffewhere_line_unknown ();
-  l->doref_col = ffewhere_column_unknown ();
-  l->definition_line = ffewhere_line_unknown ();
-  l->definition_col = ffewhere_column_unknown ();
-  l->type = FFELAB_typeUNKNOWN;
-  ffelab_list_ = l;
-  return l;
-}
diff --git a/gcc/f/lab.h b/gcc/f/lab.h
deleted file mode 100644
index f3f8986..0000000
--- a/gcc/f/lab.h
+++ /dev/null
@@ -1,152 +0,0 @@
-/* lab.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      lab.c
-
-   Modifications:
-      22-Aug-89	 JCB  1.1
-	 Change for new ffewhere interface.
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_LAB_H
-#define GCC_F_LAB_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFELAB_typeUNKNOWN,		/* No info yet on label. */
-    FFELAB_typeANY,		/* Label valid for anything, no msgs. */
-    FFELAB_typeUSELESS,		/* No valid way to reference this label. */
-    FFELAB_typeASSIGNABLE,	/* Target of ASSIGN: so FORMAT or BRANCH. */
-    FFELAB_typeFORMAT,		/* FORMAT label. */
-    FFELAB_typeLOOPEND,		/* Target of a labeled DO statement. */
-    FFELAB_typeNOTLOOP,		/* Branch target statement not valid DO
-				   target. */
-    FFELAB_typeENDIF,		/* END IF label. */
-    FFELAB_type
-  } ffelabType;
-
-#define FFELAB_valueNONE 0
-#define FFELAB_valueMAX 99999
-
-/* Typedefs. */
-
-typedef struct _ffelab_ *ffelab;
-typedef ffelab ffelabHandle;
-typedef unsigned long ffelabNumber;	/* Count of new labels. */
-#define ffelabNumber_f "l"
-typedef unsigned long ffelabValue;
-#define ffelabValue_f "l"
-
-/* Include files needed by this one. */
-
-#include "com.h"
-#include "where.h"
-
-/* Structure definitions. */
-
-struct _ffelab_
-  {
-    ffelab next;
-    ffecomLabel hook;
-    ffelabValue value;		/* 1 through 99999, or 100000+ for temp
-				   labels. */
-    unsigned long blocknum;	/* Managed entirely by user of module. */
-    ffewhereLine firstref_line;
-    ffewhereColumn firstref_col;
-    ffewhereLine doref_line;
-    ffewhereColumn doref_col;
-    ffewhereLine definition_line;	/* ffewhere_line_unknown() if not
-					   defined. */
-    ffewhereColumn definition_col;
-    ffelabType type;
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern ffelab ffelab_list_;
-extern ffelabNumber ffelab_num_news_;
-
-/* Declare functions with prototypes. */
-
-ffelab ffelab_find (ffelabValue v);
-void ffelab_finish (void);
-void ffelab_init_3 (void);
-ffelab ffelab_new (ffelabValue v);
-
-/* Define macros. */
-
-#define ffelab_blocknum(l) ((l)->blocknum)
-#define ffelab_definition_column(l) ((l)->definition_col)
-#define ffelab_definition_filename(l) \
-      ffewhere_line_filename((l)->definition_line)
-#define ffelab_definition_filelinenum(l) \
-      ffewhere_line_filelinenum((l)->definition_line)
-#define ffelab_definition_line(l) ((l)->definition_line)
-#define ffelab_definition_line_number(l) \
-      ffewhere_line_number((l)->definition_line)
-#define ffelab_doref_column(l) ((l)->doref_col)
-#define ffelab_doref_filename(l) ffewhere_line_filename((l)->doref_line)
-#define ffelab_doref_filelinenum(l) ffewhere_line_filelinenum((l)->doref_line)
-#define ffelab_doref_line(l) ((l)->doref_line)
-#define ffelab_doref_line_number(l) ffewhere_line_number((l)->doref_line)
-#define ffelab_firstref_column(l) ((l)->firstref_col)
-#define ffelab_firstref_filename(l) ffewhere_line_filename((l)->firstref_line)
-#define ffelab_firstref_filelinenum(l) \
-      ffewhere_line_filelinenum((l)->firstref_line)
-#define ffelab_firstref_line(l) ((l)->firstref_line)
-#define ffelab_firstref_line_number(l) ffewhere_line_number((l)->firstref_line)
-#define ffelab_handle_done(h)
-#define ffelab_handle_first() ((ffelabHandle) ffelab_list_)
-#define ffelab_handle_next(h) ((ffelabHandle) (((ffelab) h)->next))
-#define ffelab_handle_target(h) ((ffelab) h)
-#define ffelab_hook(l) ((l)->hook)
-#define ffelab_init_0()
-#define ffelab_init_1()
-#define ffelab_init_2()
-#define ffelab_init_4()
-#define ffelab_kill(l) ffelab_set_value(l,FFELAB_valueNONE);
-#define ffelab_new_generated() (ffelab_new(ffelab_generated_++))
-#define ffelab_number() (ffelab_num_news_)
-#define ffelab_set_blocknum(l,b) ((l)->blocknum = (b))
-#define ffelab_set_definition_column(l,cn) ((l)->definition_col = (cn))
-#define ffelab_set_definition_line(l,ln) ((l)->definition_line = (ln))
-#define ffelab_set_doref_column(l,cn) ((l)->doref_col = (cn))
-#define ffelab_set_doref_line(l,ln) ((l)->doref_line = (ln))
-#define ffelab_set_firstref_column(l,cn) ((l)->firstref_col = (cn))
-#define ffelab_set_firstref_line(l,ln) ((l)->firstref_line = (ln))
-#define ffelab_set_hook(l,h) ((l)->hook = (h))
-#define ffelab_set_type(l,t) ((l)->type = (t))
-#define ffelab_terminate_0()
-#define ffelab_terminate_1()
-#define ffelab_terminate_2()
-#define ffelab_terminate_3()
-#define ffelab_terminate_4()
-#define ffelab_type(l) ((l)->type)
-#define ffelab_value(l) ((l)->value)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_LAB_H */
diff --git a/gcc/f/lang-specs.h b/gcc/f/lang-specs.h
deleted file mode 100644
index f1281d6..0000000
--- a/gcc/f/lang-specs.h
+++ /dev/null
@@ -1,47 +0,0 @@
-/* lang-specs.h file for Fortran
-   Copyright (C) 1995, 1996, 1997, 1999, 2000, 2002, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-*/
-
-/* This is the contribution to the `default_compilers' array in gcc.c for
-   g77.  */
-
-  {".F",   "@f77-cpp-input", 0, 0, 0},
-  {".fpp", "@f77-cpp-input", 0, 0, 0},
-  {".FPP", "@f77-cpp-input", 0, 0, 0},
-  {"@f77-cpp-input",
-   "cc1 -E -traditional-cpp -D_LANGUAGE_FORTRAN %(cpp_options) \
-        %{E|M|MM:%(cpp_debug_options)}\
-        %{!M:%{!MM:%{!E: -o %|.f |\n\
-    f771 %|.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
-  {".r", "@ratfor", 0, 0, 0},
-  {"@ratfor",
-   "%{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 %m.f %(cc1_options) %{I*} %{!fsyntax-only:%(invoke_as)}}", 0, 0, 0},
-  {".f",   "@f77", 0, 0, 0},
-  {".for", "@f77", 0, 0, 0},
-  {".FOR", "@f77", 0, 0, 0},
-  {"@f77",
-   "%{!M:%{!MM:%{!E:f771 %i %(cc1_options) %{I*}\
-	%{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
diff --git a/gcc/f/lang.opt b/gcc/f/lang.opt
deleted file mode 100644
index d6a53b7..0000000
--- a/gcc/f/lang.opt
+++ /dev/null
@@ -1,402 +0,0 @@
-; 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/gcc/f/lex.c b/gcc/f/lex.c
deleted file mode 100644
index 9a38ad5..0000000
--- a/gcc/f/lex.c
+++ /dev/null
@@ -1,4575 +0,0 @@
-/* Implementation of Fortran lexer
-   Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 "proj.h"
-#include "top.h"
-#include "bad.h"
-#include "com.h"
-#include "lex.h"
-#include "malloc.h"
-#include "src.h"
-#include "debug.h"
-#include "flags.h"
-#include "input.h"
-#include "toplev.h"
-#include "output.h"
-#include "ggc.h"
-
-static void ffelex_append_to_token_ (char c);
-static int ffelex_backslash_ (int c, ffewhereColumnNumber col);
-static void ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0,
-			   ffewhereColumnNumber cn0);
-static void ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0,
-			   ffewhereColumnNumber cn0, ffewhereLineNumber ln1,
-			   ffewhereColumnNumber cn1);
-static void ffelex_bad_here_ (int num, ffewhereLineNumber ln0,
-			      ffewhereColumnNumber cn0);
-static void ffelex_finish_statement_ (void);
-static int ffelex_get_directive_line_ (char **text, FILE *finput);
-static int ffelex_hash_ (FILE *f);
-static ffewhereColumnNumber ffelex_image_char_ (int c,
-						ffewhereColumnNumber col);
-static void ffelex_include_ (void);
-static bool ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col);
-static bool ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col);
-static void ffelex_next_line_ (void);
-static void ffelex_prepare_eos_ (void);
-static void ffelex_send_token_ (void);
-static ffelexHandler ffelex_swallow_tokens_ (ffelexToken t);
-static ffelexToken ffelex_token_new_ (void);
-
-/* Pertaining to the geometry of the input file.  */
-
-/* Initial size for card image to be allocated.  */
-#define FFELEX_columnINITIAL_SIZE_ 255
-
-/* The card image itself, which grows as source lines get longer.  It
-   has room for ffelex_card_size_ + 8 characters, and the length of the
-   current image is ffelex_card_length_.  (The + 8 characters are made
-   available for easy handling of tabs and such.)  */
-static char *ffelex_card_image_;
-static ffewhereColumnNumber ffelex_card_size_;
-static ffewhereColumnNumber ffelex_card_length_;
-
-/* Max width for free-form lines (ISO F90).  */
-#define FFELEX_FREE_MAX_COLUMNS_ 132
-
-/* True if we saw a tab on the current line, as this (currently) means
-   the line is therefore treated as though final_nontab_column_ were
-   infinite.  */
-static bool ffelex_saw_tab_;
-
-/* TRUE if current line is known to be erroneous, so don't bother
-   expanding room for it just to display it.  */
-static bool ffelex_bad_line_ = FALSE;
-
-/* Last column for vanilla, i.e. non-tabbed, line.  Usually 72 or 132. */
-static ffewhereColumnNumber ffelex_final_nontab_column_;
-
-/* Array for quickly deciding what kind of line the current card has,
-   based on its first character.  */
-static ffelexType ffelex_first_char_[256];
-
-/* Pertaining to file management.  */
-
-/* The wf argument of the most recent active ffelex_file_(fixed,free)
-   function.  */
-static GTY (()) ffewhereFile ffelex_current_wf_;
-
-/* TRUE if an INCLUDE statement can be processed (ffelex_set_include
-   can be called).  */
-static bool ffelex_permit_include_;
-
-/* TRUE if an INCLUDE statement is pending (ffelex_set_include has been
-   called).  */
-static bool ffelex_set_include_;
-
-/* Information on the pending INCLUDE file.  */
-static FILE *ffelex_include_file_;
-static bool ffelex_include_free_form_;
-static GTY(()) ffewhereFile ffelex_include_wherefile_;
-
-/* Current master line count.  */
-static ffewhereLineNumber ffelex_linecount_current_;
-/* Next master line count.  */
-static ffewhereLineNumber ffelex_linecount_next_;
-
-/* ffewhere info on the latest (currently active) line read from the
-   active source file.  */
-static ffewhereLine ffelex_current_wl_;
-static ffewhereColumn ffelex_current_wc_;
-
-/* Pertaining to tokens in general.  */
-
-/* Initial capacity for text in a CHARACTER/HOLLERITH/NAME/NAMES/NUMBER
-   token.  */
-#define FFELEX_columnTOKEN_SIZE_ 63
-#if FFELEX_columnTOKEN_SIZE_ < FFEWHERE_indexMAX
-#error "token size too small!"
-#endif
-
-/* Current token being lexed.  */
-static ffelexToken ffelex_token_;
-
-/* Handler for current token.  */
-static ffelexHandler ffelex_handler_;
-
-/* TRUE if fixed-form lexer is to generate NAMES instead of NAME tokens.  */
-static bool ffelex_names_;
-
-/* TRUE if both lexers are to generate NAMES instead of NAME tokens.  */
-static bool ffelex_names_pure_;
-
-/* TRUE if 0-9 starts a NAME token instead of NUMBER, for parsing hex
-   numbers.  */
-static bool ffelex_hexnum_;
-
-/* For ffelex_swallow_tokens().  */
-static ffelexHandler ffelex_eos_handler_;
-
-/* Number of tokens sent since last EOS or beginning of input file
-   (include INCLUDEd files).  */
-static unsigned long int ffelex_number_of_tokens_;
-
-/* Number of labels sent (as NUMBER tokens) since last reset of
-   ffelex_number_of_tokens_ to 0, should be 0 or 1 in most cases.
-   (Fixed-form source only.)  */
-static unsigned long int ffelex_label_tokens_;
-
-/* Metering for token management, to catch token-memory leaks.  */
-static long int ffelex_total_tokens_ = 0;
-static long int ffelex_old_total_tokens_ = 1;
-static long int ffelex_token_nextid_ = 0;
-
-/* Pertaining to lexing CHARACTER and HOLLERITH tokens.  */
-
-/* >0 if a Hollerith constant of that length might be in mid-lex, used
-   when the next character seen is 'H' or 'h' to enter HOLLERITH lexing
-   mode (see ffelex_raw_mode_).  */
-static long int ffelex_expecting_hollerith_;
-
-/* -3: Backslash (escape) sequence being lexed in CHARACTER.
-   -2: Possible closing apostrophe/quote seen in CHARACTER.
-   -1: Lexing CHARACTER.
-    0: Not lexing CHARACTER or HOLLERITH.
-   >0: Lexing HOLLERITH, value is # chars remaining to expect.  */
-static long int ffelex_raw_mode_;
-
-/* When lexing CHARACTER, open quote/apostrophe (either ' or ").  */
-static char ffelex_raw_char_;
-
-/* TRUE when backslash processing had to use most recent character
-   to finish its state engine, but that character is not part of
-   the backslash sequence, so must be reconsidered as a "normal"
-   character in CHARACTER/HOLLERITH lexing.  */
-static bool ffelex_backslash_reconsider_ = FALSE;
-
-/* Characters preread before lexing happened (might include EOF).  */
-static int *ffelex_kludge_chars_ = NULL;
-
-/* Doing the kludge processing, so not initialized yet.  */
-static bool ffelex_kludge_flag_ = FALSE;
-
-/* The beginning of a (possible) CHARACTER/HOLLERITH token.  */
-static ffewhereLine ffelex_raw_where_line_;
-static ffewhereColumn ffelex_raw_where_col_;
-
-
-/* Call this to append another character to the current token.	If it isn't
-   currently big enough for it, it will be enlarged.  The current token
-   must be a CHARACTER, HOLLERITH, NAME, NAMES, or NUMBER.  */
-
-static void
-ffelex_append_to_token_ (char c)
-{
-  if (ffelex_token_->text == NULL)
-    {
-      ffelex_token_->text
-	= malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			  FFELEX_columnTOKEN_SIZE_ + 1);
-      ffelex_token_->size = FFELEX_columnTOKEN_SIZE_;
-      ffelex_token_->length = 0;
-    }
-  else if (ffelex_token_->length >= ffelex_token_->size)
-    {
-      ffelex_token_->text
-	= malloc_resize_ksr (malloc_pool_image (),
-			     ffelex_token_->text,
-			     (ffelex_token_->size << 1) + 1,
-			     ffelex_token_->size + 1);
-      ffelex_token_->size <<= 1;
-      assert (ffelex_token_->length < ffelex_token_->size);
-    }
-  ffelex_token_->text[ffelex_token_->length++] = c;
-}
-
-/* Do backslash (escape) processing for a CHARACTER/HOLLERITH token
-   being lexed.  */
-
-static int
-ffelex_backslash_ (int c, ffewhereColumnNumber col)
-{
-  static int state = 0;
-  static unsigned int count;
-  static int code;
-  static unsigned int firstdig = 0;
-  static int nonnull;
-  static ffewhereLineNumber line;
-  static ffewhereColumnNumber column;
-
-  /* See gcc/c-lex.c readescape() for a straightforward version
-     of this state engine for handling backslashes in character/
-     hollerith constants.  */
-
-#define wide_flag 0
-
-  switch (state)
-    {
-    case 0:
-      if ((c == '\\')
-	  && (ffelex_raw_mode_ != 0)
-	  && ffe_is_backslash ())
-	{
-	  state = 1;
-	  column = col + 1;
-	  line = ffelex_linecount_current_;
-	  return EOF;
-	}
-      return c;
-
-    case 1:
-      state = 0;		/* Assume simple case. */
-      switch (c)
-	{
-	case 'x':
-	  code = 0;
-	  count = 0;
-	  nonnull = 0;
-	  state = 2;
-	  return EOF;
-
-	case '0':  case '1':  case '2':  case '3':  case '4':
-	case '5':  case '6':  case '7':
-	  code = c - '0';
-	  count = 1;
-	  state = 3;
-	  return EOF;
-
-	case '\\': case '\'': case '"':
-	  return c;
-
-#if 0	/* Inappropriate for Fortran. */
-	case '\n':
-	  ffelex_next_line_ ();
-	  *ignore_ptr = 1;
-	  return 0;
-#endif
-
-	case 'n':
-	  return TARGET_NEWLINE;
-
-	case 't':
-	  return TARGET_TAB;
-
-	case 'r':
-	  return TARGET_CR;
-
-	case 'f':
-	  return TARGET_FF;
-
-	case 'b':
-	  return TARGET_BS;
-
-	case 'a':
-	  return TARGET_BELL;
-
-	case 'v':
-	  return TARGET_VT;
-
-	case 'e':
-	case 'E':
-	case '(':
-	case '{':
-	case '[':
-	case '%':
-	  if (pedantic)
-	    {
-	      char m[2];
-
-	      m[0] = c;
-	      m[1] = '\0';
-	      /* xgettext:no-c-format */
-	      ffebad_start_msg_lex ("Non-ISO-C-standard escape sequence `\\%A' at %0",
-				    FFEBAD_severityPEDANTIC);
-	      ffelex_bad_here_ (0, line, column);
-	      ffebad_string (m);
-	      ffebad_finish ();
-	    }
-	  return (c == 'E' || c == 'e') ? 033 : c;
-
-	case '?':
-	  return c;
-
-	default:
-	  if (c >= 040 && c < 0177)
-	    {
-	      char m[2];
-
-	      m[0] = c;
-	      m[1] = '\0';
-	      /* xgettext:no-c-format */
-	      ffebad_start_msg_lex ("Unknown escape sequence `\\%A' at %0",
-				    FFEBAD_severityPEDANTIC);
-	      ffelex_bad_here_ (0, line, column);
-	      ffebad_string (m);
-	      ffebad_finish ();
-	    }
-	  else if (c == EOF)
-	    {
-	      /* xgettext:no-c-format */
-	      ffebad_start_msg_lex ("Unterminated escape sequence `\\' at %0",
-				    FFEBAD_severityPEDANTIC);
-	      ffelex_bad_here_ (0, line, column);
-	      ffebad_finish ();
-	    }
-	  else
-	    {
-	      char m[20];
-
-	      sprintf (&m[0], "%x", c);
-	      /* xgettext:no-c-format */
-	      ffebad_start_msg_lex ("Unknown escape sequence `\\' followed by char code 0x%A at %0",
-				    FFEBAD_severityPEDANTIC);
-	      ffelex_bad_here_ (0, line, column);
-	      ffebad_string (m);
-	      ffebad_finish ();
-	    }
-	}
-      return c;
-
-    case 2:
-      if (ISXDIGIT (c))
-	{
-	  code = (code * 16) + hex_value (c);
-	  if (code != 0 || count != 0)
-	    {
-	      if (count == 0)
-		firstdig = code;
-	      count++;
-	    }
-	  nonnull = 1;
-	  return EOF;
-	}
-
-      state = 0;
-
-      if (! nonnull)
-	{
-	  /* xgettext:no-c-format */
-	  ffebad_start_msg_lex ("\\x used at %0 with no following hex digits",
-				FFEBAD_severityFATAL);
-	  ffelex_bad_here_ (0, line, column);
-	  ffebad_finish ();
-	}
-      else if (count == 0)
-	/* Digits are all 0's.  Ok.  */
-	;
-      else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
-	       || (count > 1
-		   && ((1 << (TYPE_PRECISION (integer_type_node) - (count - 1) * 4))
-		       <= (int) firstdig)))
-	{
-	  /* xgettext:no-c-format */
-	  ffebad_start_msg_lex ("Hex escape at %0 out of range",
-				FFEBAD_severityPEDANTIC);
-	  ffelex_bad_here_ (0, line, column);
-	  ffebad_finish ();
-	}
-      break;
-
-    case 3:
-      if ((c <= '7') && (c >= '0') && (count++ < 3))
-	{
-	  code = (code * 8) + (c - '0');
-	  return EOF;
-	}
-      state = 0;
-      break;
-
-    default:
-      assert ("bad backslash state" == NULL);
-      abort ();
-    }
-
-  /* Come here when code has a built character, and c is the next
-     character that might (or might not) be the next one in the constant.  */
-
-  /* Don't bother doing this check for each character going into
-     CHARACTER or HOLLERITH constants, just the escaped-value ones.
-     gcc apparently checks every single character, which seems
-     like it'd be kinda slow and not worth doing anyway.  */
-
-  if (!wide_flag
-      && TYPE_PRECISION (char_type_node) < HOST_BITS_PER_INT
-      && code >= (1 << TYPE_PRECISION (char_type_node)))
-    {
-      /* xgettext:no-c-format */
-      ffebad_start_msg_lex ("Escape sequence at %0 out of range for character",
-			    FFEBAD_severityFATAL);
-      ffelex_bad_here_ (0, line, column);
-      ffebad_finish ();
-    }
-
-  if (c == EOF)
-    {
-      /* Known end of constant, just append this character.  */
-      ffelex_append_to_token_ (code);
-      if (ffelex_raw_mode_ > 0)
-	--ffelex_raw_mode_;
-      return EOF;
-    }
-
-  /* Have two characters to handle.  Do the first, then leave it to the
-     caller to detect anything special about the second.  */
-
-  ffelex_append_to_token_ (code);
-  if (ffelex_raw_mode_ > 0)
-    --ffelex_raw_mode_;
-  ffelex_backslash_reconsider_ = TRUE;
-  return c;
-}
-
-/* ffelex_bad_1_ -- Issue diagnostic with one source point
-
-   ffelex_bad_1_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1);
-
-   Creates ffewhere line and column objects for the source point, sends them
-   along with the error code to ffebad, then kills the line and column
-   objects before returning.  */
-
-static void
-ffelex_bad_1_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0)
-{
-  ffewhereLine wl0;
-  ffewhereColumn wc0;
-
-  wl0 = ffewhere_line_new (ln0);
-  wc0 = ffewhere_column_new (cn0);
-  ffebad_start_lex (errnum);
-  ffebad_here (0, wl0, wc0);
-  ffebad_finish ();
-  ffewhere_line_kill (wl0);
-  ffewhere_column_kill (wc0);
-}
-
-/* ffelex_bad_2_ -- Issue diagnostic with two source points
-
-   ffelex_bad_2_(FFEBAD_SOME_ERROR,ffelex_linecount_current_,column + 1,
-	 otherline,othercolumn);
-
-   Creates ffewhere line and column objects for the source points, sends them
-   along with the error code to ffebad, then kills the line and column
-   objects before returning.  */
-
-static void
-ffelex_bad_2_ (ffebad errnum, ffewhereLineNumber ln0, ffewhereColumnNumber cn0,
-	       ffewhereLineNumber ln1, ffewhereColumnNumber cn1)
-{
-  ffewhereLine wl0, wl1;
-  ffewhereColumn wc0, wc1;
-
-  wl0 = ffewhere_line_new (ln0);
-  wc0 = ffewhere_column_new (cn0);
-  wl1 = ffewhere_line_new (ln1);
-  wc1 = ffewhere_column_new (cn1);
-  ffebad_start_lex (errnum);
-  ffebad_here (0, wl0, wc0);
-  ffebad_here (1, wl1, wc1);
-  ffebad_finish ();
-  ffewhere_line_kill (wl0);
-  ffewhere_column_kill (wc0);
-  ffewhere_line_kill (wl1);
-  ffewhere_column_kill (wc1);
-}
-
-static void
-ffelex_bad_here_ (int n, ffewhereLineNumber ln0,
-		  ffewhereColumnNumber cn0)
-{
-  ffewhereLine wl0;
-  ffewhereColumn wc0;
-
-  wl0 = ffewhere_line_new (ln0);
-  wc0 = ffewhere_column_new (cn0);
-  ffebad_here (n, wl0, wc0);
-  ffewhere_line_kill (wl0);
-  ffewhere_column_kill (wc0);
-}
-
-static int
-ffelex_getc_ (FILE *finput)
-{
-  int c;
-
-  if (ffelex_kludge_chars_ == NULL)
-    return getc (finput);
-
-  c = *ffelex_kludge_chars_++;
-  if (c != 0)
-    return c;
-
-  ffelex_kludge_chars_ = NULL;
-  return getc (finput);
-}
-
-static int
-ffelex_cfebackslash_ (int *use_d, int *d, FILE *finput)
-{
-  register int c = getc (finput);
-  register int code;
-  register unsigned count;
-  unsigned firstdig = 0;
-  int nonnull;
-
-  *use_d = 0;
-
-  switch (c)
-    {
-    case 'x':
-      code = 0;
-      count = 0;
-      nonnull = 0;
-      while (1)
-	{
-	  c = getc (finput);
-	  if (! ISXDIGIT (c))
-	    {
-	      *use_d = 1;
-	      *d = c;
-	      break;
-	    }
-	  code = (code * 16) + hex_value (c);
-	  if (code != 0 || count != 0)
-	    {
-	      if (count == 0)
-		firstdig = code;
-	      count++;
-	    }
-	  nonnull = 1;
-	}
-      if (! nonnull)
-	error ("\\x used with no following hex digits");
-      else if (count == 0)
-	/* Digits are all 0's.  Ok.  */
-	;
-      else if ((count - 1) * 4 >= TYPE_PRECISION (integer_type_node)
-	       || (count > 1
-		   && (((unsigned) 1
-			<< (TYPE_PRECISION (integer_type_node) - (count - 1)
-			    * 4))
-		       <= firstdig)))
-	pedwarn ("hex escape out of range");
-      return code;
-
-    case '0':  case '1':  case '2':  case '3':  case '4':
-    case '5':  case '6':  case '7':
-      code = 0;
-      count = 0;
-      while ((c <= '7') && (c >= '0') && (count++ < 3))
-	{
-	  code = (code * 8) + (c - '0');
-	  c = getc (finput);
-	}
-      *use_d = 1;
-      *d = c;
-      return code;
-
-    case '\\': case '\'': case '"':
-      return c;
-
-    case '\n':
-      ffelex_next_line_ ();
-      *use_d = 2;
-      return 0;
-
-    case EOF:
-      *use_d = 1;
-      *d = EOF;
-      return EOF;
-
-    case 'n':
-      return TARGET_NEWLINE;
-
-    case 't':
-      return TARGET_TAB;
-
-    case 'r':
-      return TARGET_CR;
-
-    case 'f':
-      return TARGET_FF;
-
-    case 'b':
-      return TARGET_BS;
-
-    case 'a':
-      return TARGET_BELL;
-
-    case 'v':
-      return TARGET_VT;
-
-    case 'e':
-    case 'E':
-      if (pedantic)
-	pedwarn ("non-ANSI-standard escape sequence, `\\%c'", c);
-      return 033;
-
-    case '?':
-      return c;
-
-      /* `\(', etc, are used at beginning of line to avoid confusing Emacs.  */
-    case '(':
-    case '{':
-    case '[':
-      /* `\%' is used to prevent SCCS from getting confused.  */
-    case '%':
-      if (pedantic)
-	pedwarn ("non-ISO escape sequence `\\%c'", c);
-      return c;
-    }
-  if (c >= 040 && c < 0177)
-    pedwarn ("unknown escape sequence `\\%c'", c);
-  else
-    pedwarn ("unknown escape sequence: `\\' followed by char code 0x%x", c);
-  return c;
-}
-
-/* A miniature version of the C front-end lexer.  */
-
-static int
-ffelex_cfelex_ (ffelexToken *xtoken, FILE *finput, int c)
-{
-  ffelexToken token;
-  char buff[129];
-  char *p;
-  char *q;
-  char *r;
-  register unsigned buffer_length;
-
-  if ((*xtoken != NULL) && !ffelex_kludge_flag_)
-    ffelex_token_kill (*xtoken);
-
-  switch (c)
-    {
-    case '0': case '1': case '2': case '3': case '4':
-    case '5': case '6': case '7': case '8': case '9':
-      buffer_length = ARRAY_SIZE (buff);
-      p = &buff[0];
-      q = p;
-      r = &buff[buffer_length];
-      for (;;)
-	{
-	  *p++ = c;
-	  if (p >= r)
-	    {
-	      register unsigned bytes_used = (p - q);
-
-	      buffer_length *= 2;
-	      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];
-	    }
-	  c = ffelex_getc_ (finput);
-	  if (! ISDIGIT (c))
-	    break;
-	}
-      *p = '\0';
-      token = ffelex_token_new_number (q, ffewhere_line_unknown (),
-				       ffewhere_column_unknown ());
-
-      if (q != &buff[0])
-	free (q);
-
-      break;
-
-    case '\"':
-      buffer_length = ARRAY_SIZE (buff);
-      p = &buff[0];
-      q = p;
-      r = &buff[buffer_length];
-      c = ffelex_getc_ (finput);
-      for (;;)
-	{
-	  bool done = FALSE;
-	  int use_d = 0;
-	  int d = 0;
-
-	  switch (c)
-	    {
-	    case '\"':
-	      c = getc (finput);
-	      done = TRUE;
-	      break;
-
-	    case '\\':		/* ~~~~~ */
-	      c = ffelex_cfebackslash_ (&use_d, &d, finput);
-	      break;
-
-	    case EOF:
-	    case '\n':
-	      error ("badly formed directive -- no closing quote");
-	      done = TRUE;
-	      break;
-
-	    default:
-	      break;
-	    }
-	  if (done)
-	    break;
-
-	  if (use_d != 2)	/* 0=>c, 1=>cd, 2=>nil. */
-	    {
-	      *p++ = c;
-	      if (p >= r)
-		{
-		  register unsigned bytes_used = (p - q);
-
-		  buffer_length = bytes_used * 2;
-		  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];
-		}
-	    }
-	  if (use_d == 1)
-	    c = d;
-	  else
-	    c = getc (finput);
-	}
-      *p = '\0';
-      token = ffelex_token_new_character (q, ffewhere_line_unknown (),
-					  ffewhere_column_unknown ());
-
-      if (q != &buff[0])
-	free (q);
-
-      break;
-
-    default:
-      token = NULL;
-      break;
-    }
-
-  *xtoken = token;
-  return c;
-}
-
-static void
-ffelex_file_pop_ (const char *filename)
-{
-  if (input_file_stack->next)
-    {
-      struct file_stack *p = input_file_stack;
-      input_file_stack = p->next;
-      free (p);
-      input_file_stack_tick++;
-      (*debug_hooks->end_source_file) (input_file_stack->location.line);
-    }
-  else
-    error ("#-lines for entering and leaving files don't match");
-
-  /* Now that we've pushed or popped the input stack,
-     update the name in the top element.  */
-  if (input_file_stack)
-    input_file_stack->location.file = filename;
-}
-
-static void
-ffelex_file_push_ (int old_lineno, const char *filename)
-{
-  struct file_stack *p = xmalloc (sizeof (struct file_stack));
-
-  input_file_stack->location.line = old_lineno;
-  p->next = input_file_stack;
-  p->location.file = filename;
-  input_file_stack = p;
-  input_file_stack_tick++;
-
-  (*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->location.file = filename;
-}
-
-/* Prepare to finish a statement-in-progress by sending the current
-   token, if any, then setting up EOS as the current token with the
-   appropriate current pointer.  The caller can then move the current
-   pointer before actually sending EOS, if desired, as it is in
-   typical fixed-form cases.  */
-
-static void
-ffelex_prepare_eos_ (void)
-{
-  if (ffelex_token_->type != FFELEX_typeNONE)
-    {
-      ffelex_backslash_ (EOF, 0);
-
-      switch (ffelex_raw_mode_)
-	{
-	case -2:
-	  break;
-
-	case -1:
-	  ffebad_start_lex ((ffelex_raw_char_ == '\'') ? FFEBAD_NO_CLOSING_APOSTROPHE
-			    : FFEBAD_NO_CLOSING_QUOTE);
-	  ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
-	  ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
-	  ffebad_finish ();
-	  break;
-
-	case 0:
-	  break;
-
-	default:
-	  {
-	    char num[20];
-
-	    ffebad_start_lex (FFEBAD_NOT_ENOUGH_HOLLERITH_CHARS);
-	    ffebad_here (0, ffelex_token_->where_line, ffelex_token_->where_col);
-	    ffebad_here (1, ffelex_current_wl_, ffelex_current_wc_);
-	    sprintf (num, "%lu", (unsigned long) ffelex_raw_mode_);
-	    ffebad_string (num);
-	    ffebad_finish ();
-	    /* Make sure the token has some text, might as well fill up with spaces.  */
-	    do
-	      {
-		ffelex_append_to_token_ (' ');
-	      } while (--ffelex_raw_mode_ > 0);
-	    break;
-	  }
-	}
-      ffelex_raw_mode_ = 0;
-      ffelex_send_token_ ();
-    }
-  ffelex_token_->type = FFELEX_typeEOS;
-  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-  ffelex_token_->where_col = ffewhere_column_use (ffelex_current_wc_);
-}
-
-static void
-ffelex_finish_statement_ (void)
-{
-  if ((ffelex_number_of_tokens_ == 0)
-      && (ffelex_token_->type == FFELEX_typeNONE))
-    return;			/* Don't have a statement pending. */
-
-  if (ffelex_token_->type != FFELEX_typeEOS)
-    ffelex_prepare_eos_ ();
-
-  ffelex_permit_include_ = TRUE;
-  ffelex_send_token_ ();
-  ffelex_permit_include_ = FALSE;
-  ffelex_number_of_tokens_ = 0;
-  ffelex_label_tokens_ = 0;
-  ffelex_names_ = TRUE;
-  ffelex_names_pure_ = FALSE;	/* Probably not necessary. */
-  ffelex_hexnum_ = FALSE;
-
-  if (!ffe_is_ffedebug ())
-    return;
-
-  /* For debugging purposes only. */
-
-  if (ffelex_total_tokens_ != ffelex_old_total_tokens_)
-    {
-      fprintf (dmpout, "; token_track had %ld tokens, now have %ld.\n",
-	       ffelex_old_total_tokens_, ffelex_total_tokens_);
-      ffelex_old_total_tokens_ = ffelex_total_tokens_;
-    }
-}
-
-/* Read a preprocessor directive line from file FINPUT.  This function
-   returns either '\n' or EOF to indicate success or failure respectively.
-   Upon return, TEXT points to the contents of the line, which is stripped
-   of initial whitespace.  The buffer pointed to by TEXT should not be
-   free'd and is overwritten by subsequent calls to this function.  */
-
-static int
-ffelex_get_directive_line_ (char **text, FILE *finput)
-{
-  static char *directive_buffer = NULL;
-  static unsigned buffer_length = 0;
-  register char *p;
-  register char *buffer_limit;
-  register int looking_for = 0;
-  register int char_escaped = 0;
-
-  if (buffer_length == 0)
-    {
-      directive_buffer = xmalloc (128);
-      buffer_length = 128;
-    }
-
-  buffer_limit = &directive_buffer[buffer_length];
-
-  for (p = directive_buffer; ; )
-    {
-      int c;
-
-      /* Make buffer bigger if it is full.  */
-      if (p >= buffer_limit)
-	{
-	  register unsigned bytes_used = (p - directive_buffer);
-
-	  buffer_length *= 2;
-	  directive_buffer = xrealloc (directive_buffer, buffer_length);
-	  p = &directive_buffer[bytes_used];
-	  buffer_limit = &directive_buffer[buffer_length];
-	}
-
-      c = getc (finput);
-
-      /* Discard initial whitespace.  */
-      if ((c == ' ' || c == '\t') && p == directive_buffer)
-	continue;
-
-      /* Detect the end of the directive.  */
-      if ((c == '\n' && looking_for == 0)
-	  || c == EOF)
-	{
-	  if (looking_for != 0)
-	    error ("bad directive -- missing close-quote");
-
-	  *p++ = '\0';
-	  *text = directive_buffer;
-	  return c;
-	}
-
-      *p++ = c;
-      if (c == '\n')
-	ffelex_next_line_ ();
-
-      /* Handle string and character constant syntax.  */
-      if (looking_for)
-	{
-	  if (looking_for == c && !char_escaped)
-	    looking_for = 0;	/* Found terminator... stop looking.  */
-	}
-      else
-	if (c == '\'' || c == '"')
-	  looking_for = c;	/* Don't stop buffering until we see another
-				   one of these (or an EOF).  */
-
-      /* Handle backslash.  */
-      char_escaped = (c == '\\' && ! char_escaped);
-    }
-}
-
-/* Handle # directives that make it through (or are generated by) the
-   preprocessor.  As much as reasonably possible, emulate the behavior
-   of the gcc compiler phase cc1, though interactions between #include
-   and INCLUDE might possibly produce bizarre results in terms of
-   error reporting and the generation of debugging info vis-a-vis the
-   locations of some things.
-
-   Returns the next character unhandled, which is always newline or EOF.  */
-
-static int
-ffelex_hash_ (FILE *finput)
-{
-  register int c;
-  ffelexToken token = NULL;
-
-  /* Read first nonwhite char after the `#'.  */
-
-  c = ffelex_getc_ (finput);
-  while (c == ' ' || c == '\t')
-    c = ffelex_getc_ (finput);
-
-  /* If a letter follows, then if the word here is `line', skip
-     it and ignore it; otherwise, ignore the line, with an error
-     if the word isn't `pragma', `ident', `define', or `undef'.  */
-
-  if (ISALPHA(c))
-    {
-      if (c == 'p')
-	{
-	  if (getc (finput) == 'r'
-	      && getc (finput) == 'a'
-	      && getc (finput) == 'g'
-	      && getc (finput) == 'm'
-	      && getc (finput) == 'a'
-	      && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
-		  || c == EOF))
-	    {
-	      goto skipline;
-	    }
-	}
-      else if (c == 'd')
-	{
-	  if (getc (finput) == 'e'
-	      && getc (finput) == 'f'
-	      && getc (finput) == 'i'
-	      && getc (finput) == 'n'
-	      && getc (finput) == 'e'
-	      && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
-		  || c == EOF))
-	    {
-	      char *text;
-
-	      c = ffelex_get_directive_line_ (&text, finput);
-
-	      if (debug_info_level == DINFO_LEVEL_VERBOSE)
-		(*debug_hooks->define) (input_line, text);
-
-	      goto skipline;
-	    }
-	}
-      else if (c == 'u')
-	{
-	  if (getc (finput) == 'n'
-	      && getc (finput) == 'd'
-	      && getc (finput) == 'e'
-	      && getc (finput) == 'f'
-	      && ((c = getc (finput)) == ' ' || c == '\t' || c == '\n'
-		  || c == EOF))
-	    {
-	      char *text;
-
-	      c = ffelex_get_directive_line_ (&text, finput);
-
-	      if (debug_info_level == DINFO_LEVEL_VERBOSE)
-		(*debug_hooks->undef) (input_line, text);
-
-	      goto skipline;
-	    }
-	}
-      else if (c == 'l')
-	{
-	  if (getc (finput) == 'i'
-	      && getc (finput) == 'n'
-	      && getc (finput) == 'e'
-	      && ((c = getc (finput)) == ' ' || c == '\t'))
-	    goto linenum;
-	}
-      else if (c == 'i')
-	{
-	  if (getc (finput) == 'd'
-	      && getc (finput) == 'e'
-	      && getc (finput) == 'n'
-	      && getc (finput) == 't'
-	      && ((c = getc (finput)) == ' ' || c == '\t'))
-	    {
-	      /* #ident.  The pedantic warning is now in cpp.  */
-
-	      /* Here we have just seen `#ident '.
-		 A string constant should follow.  */
-
-	      while (c == ' ' || c == '\t')
-		c = getc (finput);
-
-	      /* If no argument, ignore the line.  */
-	      if (c == '\n' || c == EOF)
-		return c;
-
-	      c = ffelex_cfelex_ (&token, finput, c);
-
-	      if ((token == NULL)
-		  || (ffelex_token_type (token) != FFELEX_typeCHARACTER))
-		{
-		  error ("invalid #ident");
-		  goto skipline;
-		}
-
-	      if (! flag_no_ident)
-		{
-#ifdef ASM_OUTPUT_IDENT
-		  ASM_OUTPUT_IDENT (asm_out_file,
-				    ffelex_token_text (token));
-#endif
-		}
-
-	      /* Skip the rest of this line.  */
-	      goto skipline;
-	    }
-	}
-
-      error ("undefined or invalid # directive");
-      goto skipline;
-    }
-
- linenum:
-  /* Here we have either `#line' or `# <nonletter>'.
-     In either case, it should be a line number; a digit should follow.  */
-
-  while (c == ' ' || c == '\t')
-    c = ffelex_getc_ (finput);
-
-  /* If the # is the only nonwhite char on the line,
-     just ignore it.  Check the new newline.  */
-  if (c == '\n' || c == EOF)
-    return c;
-
-  /* Something follows the #; read a token.  */
-
-  c = ffelex_cfelex_ (&token, finput, c);
-
-  if ((token != NULL)
-      && (ffelex_token_type (token) == FFELEX_typeNUMBER))
-    {
-      location_t old_loc = input_location;
-      ffewhereFile wf;
-
-      /* subtract one, because it is the following line that
-	 gets the specified number */
-      int l = atoi (ffelex_token_text (token)) - 1;
-
-      /* Is this the last nonwhite stuff on the line?  */
-      while (c == ' ' || c == '\t')
-	c = ffelex_getc_ (finput);
-      if (c == '\n' || c == EOF)
-	{
-	  /* No more: store the line number and check following line.  */
-	  input_line = l;
-	  if (!ffelex_kludge_flag_)
-	    {
-	      ffewhere_file_set (NULL, TRUE, (ffewhereLineNumber) l);
-
-	      if (token != NULL)
-		ffelex_token_kill (token);
-	    }
-	  return c;
-	}
-
-      /* More follows: it must be a string constant (filename).  */
-
-      /* Read the string constant.  */
-      c = ffelex_cfelex_ (&token, finput, c);
-
-      if ((token == NULL)
-	  || (ffelex_token_type (token) != FFELEX_typeCHARACTER))
-	{
-	  error ("invalid #line");
-	  goto skipline;
-	}
-
-      input_line = l;
-
-      if (ffelex_kludge_flag_)
-	input_filename = ggc_strdup (ffelex_token_text (token));
-      else
-	{
-	  wf = ffewhere_file_new (ffelex_token_text (token),
-				  ffelex_token_length (token));
-	  input_filename = ffewhere_file_name (wf);
-	  ffewhere_file_set (wf, TRUE, (ffewhereLineNumber) l);
-	}
-
-#if 0	/* Not sure what g77 should do with this yet. */
-      /* Each change of file name
-	 reinitializes whether we are now in a system header.  */
-      in_system_header = 0;
-#endif
-
-      if (main_input_filename == 0)
-	main_input_filename = input_filename;
-
-      /* Is this the last nonwhite stuff on the line?  */
-      while (c == ' ' || c == '\t')
-	c = getc (finput);
-      if (c == '\n' || c == EOF)
-	{
-	  if (!ffelex_kludge_flag_)
-	    {
-	      /* Update the name in the top element of input_file_stack.  */
-	      if (input_file_stack)
-		input_file_stack->location.file = input_filename;
-
-	      if (token != NULL)
-		ffelex_token_kill (token);
-	    }
-	  return c;
-	}
-
-      c = ffelex_cfelex_ (&token, finput, c);
-
-      /* `1' after file name means entering new file.
-	 `2' after file name means just left a file.  */
-
-      if ((token != NULL)
-	  && (ffelex_token_type (token) == FFELEX_typeNUMBER))
-	{
-	  int num = atoi (ffelex_token_text (token));
-
-	  if (ffelex_kludge_flag_)
-	    {
-	      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_loc.line, input_filename);
-	    }
-	  else if (num == 2)
-	    {
-	      /* Popping out of a file.  */
-	      ffelex_file_pop_ (input_filename);
-	    }
-
-	  /* Is this the last nonwhite stuff on the line?  */
-	  while (c == ' ' || c == '\t')
-	    c = getc (finput);
-	  if (c == '\n' || c == EOF)
-	    {
-	      if (token != NULL)
-		ffelex_token_kill (token);
-	      return c;
-	    }
-
-	  c = ffelex_cfelex_ (&token, finput, c);
-	}
-
-      /* `3' after file name means this is a system header file.  */
-
-#if 0	/* Not sure what g77 should do with this yet. */
-      if ((token != NULL)
-	  && (ffelex_token_type (token) == FFELEX_typeNUMBER)
-	  && (atoi (ffelex_token_text (token)) == 3))
-	in_system_header = 1;
-#endif
-
-      while (c == ' ' || c == '\t')
-	c = getc (finput);
-      if (((token != NULL)
-	   || (c != '\n' && c != EOF))
-	  && ffelex_kludge_flag_)
-	{
-	  input_line = 1;
-	  input_filename = old_loc.file;
-	  error ("use `#line ...' instead of `# ...' in first line");
-	}
-      if (c == '\n' || c == EOF)
-	{
-	  if (token != NULL && !ffelex_kludge_flag_)
-	    ffelex_token_kill (token);
-	  return c;
-	}
-    }
-  else
-    error ("invalid #-line");
-
-  /* skip the rest of this line.  */
- skipline:
-  if ((token != NULL) && !ffelex_kludge_flag_)
-    ffelex_token_kill (token);
-  while ((c = getc (finput)) != EOF && c != '\n')
-    ;
-  return c;
-}
-
-/* "Image" a character onto the card image, return incremented column number.
-
-   Normally invoking this function as in
-     column = ffelex_image_char_ (c, column);
-   is the same as doing:
-     ffelex_card_image_[column++] = c;
-
-   However, tabs and carriage returns are handled specially, to preserve
-   the visual "image" of the input line (in most editors) in the card
-   image.
-
-   Carriage returns are ignored, as they are assumed to be followed
-   by newlines.
-
-   A tab is handled by first doing:
-     ffelex_card_image_[column++] = ' ';
-   That is, it translates to at least one space.  Then, as many spaces
-   are imaged as necessary to bring the column number to the next tab
-   position, where tab positions start in the ninth column and each
-   eighth column afterwards.  ALSO, a static var named ffelex_saw_tab_
-   is set to TRUE to notify the lexer that a tab was seen.
-
-   Columns are numbered and tab stops set as illustrated below:
-
-   012345670123456701234567...
-   x	   y	   z
-   xx	   yy	   zz
-   ...
-   xxxxxxx yyyyyyy zzzzzzz
-   xxxxxxxx	   yyyyyyyy...  */
-
-static ffewhereColumnNumber
-ffelex_image_char_ (int c, ffewhereColumnNumber column)
-{
-  ffewhereColumnNumber old_column = column;
-
-  if (column >= ffelex_card_size_)
-    {
-      ffewhereColumnNumber newmax = ffelex_card_size_ << 1;
-
-      if (ffelex_bad_line_)
-	return column;
-
-      if ((newmax >> 1) != ffelex_card_size_)
-	{			/* Overflowed column number. */
-	overflow:	/* :::::::::::::::::::: */
-
-	  ffelex_bad_line_ = TRUE;
-	  strcpy (&ffelex_card_image_[column - 3], "...");
-	  ffelex_card_length_ = column;
-	  ffelex_bad_1_ (FFEBAD_LINE_TOO_LONG,
-			 ffelex_linecount_current_, column + 1);
-	  return column;
-	}
-
-      ffelex_card_image_
-	= malloc_resize_ksr (malloc_pool_image (),
-			     ffelex_card_image_,
-			     newmax + 9,
-			     ffelex_card_size_ + 9);
-      ffelex_card_size_ = newmax;
-    }
-
-  switch (c)
-    {
-    case '\r':
-      break;
-
-    case '\t':
-      ffelex_saw_tab_ = TRUE;
-      ffelex_card_image_[column++] = ' ';
-      while ((column & 7) != 0)
-	ffelex_card_image_[column++] = ' ';
-      break;
-
-    case '\0':
-      if (!ffelex_bad_line_)
-	{
-	  ffelex_bad_line_ = TRUE;
-	  strcpy (&ffelex_card_image_[column], "[\\0]");
-	  ffelex_card_length_ = column + 4;
-	  /* xgettext:no-c-format */
-	  ffebad_start_msg_lex ("Null character at %0 -- line ignored",
-				FFEBAD_severityFATAL);
-	  ffelex_bad_here_ (0, ffelex_linecount_current_, column + 1);
-	  ffebad_finish ();
-	  column += 4;
-	}
-      break;
-
-    default:
-      ffelex_card_image_[column++] = c;
-      break;
-    }
-
-  if (column < old_column)
-    {
-      column = old_column;
-      goto overflow;	/* :::::::::::::::::::: */
-    }
-
-  return column;
-}
-
-static void
-ffelex_include_ (void)
-{
-  ffewhereFile include_wherefile = ffelex_include_wherefile_;
-  FILE *include_file = ffelex_include_file_;
-  /* The rest of this is to push, and after the INCLUDE file is processed,
-     pop, the static lexer state info that pertains to each particular
-     input file.  */
-  char *card_image;
-  ffewhereColumnNumber card_size = ffelex_card_size_;
-  ffewhereColumnNumber card_length = ffelex_card_length_;
-  ffewhereLine current_wl = ffelex_current_wl_;
-  ffewhereColumn current_wc = ffelex_current_wc_;
-  bool saw_tab = ffelex_saw_tab_;
-  ffewhereColumnNumber final_nontab_column = ffelex_final_nontab_column_;
-  ffewhereFile current_wf = ffelex_current_wf_;
-  ffewhereLineNumber linecount_current = ffelex_linecount_current_;
-  ffewhereLineNumber linecount_offset
-    = ffewhere_line_filelinenum (current_wl);
-  location_t old_loc = input_location;
-
-  if (card_length != 0)
-    {
-      card_image = malloc_new_ks (malloc_pool_image (),
-				  "FFELEX saved card image",
-				  card_length);
-      memcpy (card_image, ffelex_card_image_, card_length);
-    }
-  else
-    card_image = NULL;
-
-  ffelex_set_include_ = FALSE;
-
-  ffelex_next_line_ ();
-
-  ffewhere_file_set (include_wherefile, TRUE, 0);
-
-  ffelex_file_push_ (old_loc.line, ffewhere_file_name (include_wherefile));
-
-  if (ffelex_include_free_form_)
-    ffelex_file_free (include_wherefile, include_file);
-  else
-    ffelex_file_fixed (include_wherefile, include_file);
-
-  ffelex_file_pop_ (ffewhere_file_name (current_wf));
-
-  ffewhere_file_set (current_wf, TRUE, linecount_offset);
-
-  ffecom_close_include (include_file);
-
-  if (card_length != 0)
-    {
-      assert (ffelex_card_size_ >= card_length);	/* It shrunk?? */
-      memcpy (ffelex_card_image_, card_image, card_length);
-    }
-  ffelex_card_image_[card_length] = '\0';
-
-  input_location = old_loc;
-  ffelex_linecount_current_ = linecount_current;
-  ffelex_current_wf_ = current_wf;
-  ffelex_final_nontab_column_ = final_nontab_column;
-  ffelex_saw_tab_ = saw_tab;
-  ffelex_current_wc_ = current_wc;
-  ffelex_current_wl_ = current_wl;
-  ffelex_card_length_ = card_length;
-  ffelex_card_size_ = card_size;
-}
-
-/* ffelex_is_free_char_ctx_contin_ -- Character Context Continuation?
-
-   ffewhereColumnNumber col;
-   int c;  // Char at col.
-   if ((c == '&') && ffelex_is_free_char_ctx_contin_(col + 1))
-       // We have a continuation indicator.
-
-   If there are <n> spaces starting at ffelex_card_image_[col] up through
-   the null character, where <n> is 0 or greater, returns TRUE.	 */
-
-static bool
-ffelex_is_free_char_ctx_contin_ (ffewhereColumnNumber col)
-{
-  while (ffelex_card_image_[col] != '\0')
-    {
-      if (ffelex_card_image_[col++] != ' ')
-	return FALSE;
-    }
-  return TRUE;
-}
-
-/* ffelex_is_free_nonc_ctx_contin_ -- Noncharacter Context Continuation?
-
-   ffewhereColumnNumber col;
-   int c;  // Char at col.
-   if ((c == '&') && ffelex_is_free_nonc_ctx_contin_(col + 1))
-       // We have a continuation indicator.
-
-   If there are <n> spaces starting at ffelex_card_image_[col] up through
-   the null character or '!', where <n> is 0 or greater, returns TRUE.	*/
-
-static bool
-ffelex_is_free_nonc_ctx_contin_ (ffewhereColumnNumber col)
-{
-  while ((ffelex_card_image_[col] != '\0') && (ffelex_card_image_[col] != '!'))
-    {
-      if (ffelex_card_image_[col++] != ' ')
-	return FALSE;
-    }
-  return TRUE;
-}
-
-static void
-ffelex_next_line_ (void)
-{
-  ffelex_linecount_current_ = ffelex_linecount_next_;
-  ++ffelex_linecount_next_;
-  ++input_line;
-}
-
-static void
-ffelex_send_token_ (void)
-{
-  ++ffelex_number_of_tokens_;
-
-  ffelex_backslash_ (EOF, 0);
-
-  if (ffelex_token_->text == NULL)
-    {
-      if (ffelex_token_->type == FFELEX_typeCHARACTER)
-	{
-	  ffelex_append_to_token_ ('\0');
-	  ffelex_token_->length = 0;
-	}
-    }
-  else
-    ffelex_token_->text[ffelex_token_->length] = '\0';
-
-  assert (ffelex_raw_mode_ == 0);
-
-  if (ffelex_token_->type == FFELEX_typeNAMES)
-    {
-      ffewhere_line_kill (ffelex_token_->currentnames_line);
-      ffewhere_column_kill (ffelex_token_->currentnames_col);
-    }
-
-  assert (ffelex_handler_ != NULL);
-  ffelex_handler_ = (ffelexHandler) (*ffelex_handler_) (ffelex_token_);
-  assert (ffelex_handler_ != NULL);
-
-  ffelex_token_kill (ffelex_token_);
-
-  ffelex_token_ = ffelex_token_new_ ();
-  ffelex_token_->uses = 1;
-  ffelex_token_->text = NULL;
-  if (ffelex_raw_mode_ < 0)
-    {
-      ffelex_token_->type = FFELEX_typeCHARACTER;
-      ffelex_token_->where_line = ffelex_raw_where_line_;
-      ffelex_token_->where_col = ffelex_raw_where_col_;
-      ffelex_raw_where_line_ = ffewhere_line_unknown ();
-      ffelex_raw_where_col_ = ffewhere_column_unknown ();
-    }
-  else
-    {
-      ffelex_token_->type = FFELEX_typeNONE;
-      ffelex_token_->where_line = ffewhere_line_unknown ();
-      ffelex_token_->where_col = ffewhere_column_unknown ();
-    }
-
-  if (ffelex_set_include_)
-    ffelex_include_ ();
-}
-
-/* ffelex_swallow_tokens_ -- Eat all tokens delivered to me
-
-   return ffelex_swallow_tokens_;
-
-   Return this handler when you don't want to look at any more tokens in the
-   statement because you've encountered an unrecoverable error in the
-   statement.  */
-
-static ffelexHandler
-ffelex_swallow_tokens_ (ffelexToken t)
-{
-  assert (ffelex_eos_handler_ != NULL);
-
-  if ((ffelex_token_type (t) == FFELEX_typeEOS)
-      || (ffelex_token_type (t) == FFELEX_typeSEMICOLON))
-    return (ffelexHandler) (*ffelex_eos_handler_) (t);
-
-  return (ffelexHandler) ffelex_swallow_tokens_;
-}
-
-static ffelexToken
-ffelex_token_new_ (void)
-{
-  ffelexToken t;
-
-  ++ffelex_total_tokens_;
-
-  t = malloc_new_ks (malloc_pool_image (), "FFELEX token", sizeof (*t));
-  t->id_ = ffelex_token_nextid_++;
-  return t;
-}
-
-static const char *
-ffelex_type_string_ (ffelexType type)
-{
-  static const char *const types[] = {
-    "FFELEX_typeNONE",
-    "FFELEX_typeCOMMENT",
-    "FFELEX_typeEOS",
-    "FFELEX_typeEOF",
-    "FFELEX_typeERROR",
-    "FFELEX_typeRAW",
-    "FFELEX_typeQUOTE",
-    "FFELEX_typeDOLLAR",
-    "FFELEX_typeHASH",
-    "FFELEX_typePERCENT",
-    "FFELEX_typeAMPERSAND",
-    "FFELEX_typeAPOSTROPHE",
-    "FFELEX_typeOPEN_PAREN",
-    "FFELEX_typeCLOSE_PAREN",
-    "FFELEX_typeASTERISK",
-    "FFELEX_typePLUS",
-    "FFELEX_typeMINUS",
-    "FFELEX_typePERIOD",
-    "FFELEX_typeSLASH",
-    "FFELEX_typeNUMBER",
-    "FFELEX_typeOPEN_ANGLE",
-    "FFELEX_typeEQUALS",
-    "FFELEX_typeCLOSE_ANGLE",
-    "FFELEX_typeNAME",
-    "FFELEX_typeCOMMA",
-    "FFELEX_typePOWER",
-    "FFELEX_typeCONCAT",
-    "FFELEX_typeDEBUG",
-    "FFELEX_typeNAMES",
-    "FFELEX_typeHOLLERITH",
-    "FFELEX_typeCHARACTER",
-    "FFELEX_typeCOLON",
-    "FFELEX_typeSEMICOLON",
-    "FFELEX_typeUNDERSCORE",
-    "FFELEX_typeQUESTION",
-    "FFELEX_typeOPEN_ARRAY",
-    "FFELEX_typeCLOSE_ARRAY",
-    "FFELEX_typeCOLONCOLON",
-    "FFELEX_typeREL_LE",
-    "FFELEX_typeREL_NE",
-    "FFELEX_typeREL_EQ",
-    "FFELEX_typePOINTS",
-    "FFELEX_typeREL_GE"
-  };
-
-  if (type >= ARRAY_SIZE (types))
-    return "???";
-  return types[type];
-}
-
-void
-ffelex_display_token (ffelexToken t)
-{
-  if (t == NULL)
-    t = ffelex_token_;
-
-  fprintf (dmpout, "; Token #%lu is %s (line %" ffewhereLineNumber_f "u, col %"
-	   ffewhereColumnNumber_f "u)",
-	   t->id_,
-	   ffelex_type_string_ (t->type),
-	   ffewhere_line_number (t->where_line),
-	   ffewhere_column_number (t->where_col));
-
-  if (t->text != NULL)
-    fprintf (dmpout, ": \"%.*s\"\n",
-	     (int) t->length,
-	     t->text);
-  else
-    fprintf (dmpout, ".\n");
-}
-
-/* ffelex_expecting_character -- Tells if next token expected to be CHARACTER
-
-   if (ffelex_expecting_character())
-       // next token delivered by lexer will be CHARACTER.
-
-   If the most recent call to ffelex_set_expecting_hollerith since the last
-   token was delivered by the lexer passed a length of -1, then we return
-   TRUE, because the next token we deliver will be typeCHARACTER, else we
-   return FALSE.  */
-
-bool
-ffelex_expecting_character (void)
-{
-  return (ffelex_raw_mode_ != 0);
-}
-
-/* ffelex_file_fixed -- Lex a given file in fixed source form
-
-   ffewhere wf;
-   FILE *f;
-   ffelex_file_fixed(wf,f);
-
-   Lexes the file according to Fortran 90 ANSI + VXT specifications.  */
-
-ffelexHandler
-ffelex_file_fixed (ffewhereFile wf, FILE *f)
-{
-  register int c = 0;		/* Character currently under consideration. */
-  register ffewhereColumnNumber column = 0;	/* Not really; 0 means column 1... */
-  bool disallow_continuation_line;
-  bool ignore_disallowed_continuation = FALSE;
-  int latest_char_in_file = 0;	/* For getting back into comment-skipping
-				   code. */
-  ffelexType lextype;
-  ffewhereColumnNumber first_label_char;	/* First char of label --
-						   column number. */
-  char label_string[6];		/* Text of label. */
-  int labi;			/* Length of label text. */
-  bool finish_statement;	/* Previous statement finished? */
-  bool have_content;		/* This line have content? */
-  bool just_do_label;		/* Nothing but label (and continuation?) on
-				   line. */
-
-  /* Lex is called for a particular file, not for a particular program unit.
-     Yet the two events do share common characteristics.  The first line in a
-     file or in a program unit cannot be a continuation line.  No token can
-     be in mid-formation.  No current label for the statement exists, since
-     there is no current statement. */
-
-  assert (ffelex_handler_ != NULL);
-
-  input_line = 0;
-  input_filename = ffewhere_file_name (wf);
-  ffelex_current_wf_ = wf;
-  disallow_continuation_line = TRUE;
-  ignore_disallowed_continuation = FALSE;
-  ffelex_token_->type = FFELEX_typeNONE;
-  ffelex_number_of_tokens_ = 0;
-  ffelex_label_tokens_ = 0;
-  ffelex_current_wl_ = ffewhere_line_unknown ();
-  ffelex_current_wc_ = ffewhere_column_unknown ();
-  latest_char_in_file = '\n';
-
-  goto first_line;		/* :::::::::::::::::::: */
-
-  /* Come here to get a new line. */
-
- beginning_of_line:		/* :::::::::::::::::::: */
-
-  disallow_continuation_line = FALSE;
-
-  /* Come here directly when last line didn't clarify the continuation issue. */
-
- beginning_of_line_again:	/* :::::::::::::::::::: */
-
- first_line:			/* :::::::::::::::::::: */
-
-  c = latest_char_in_file;
-  if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF))
-    {
-
-    end_of_file:		/* :::::::::::::::::::: */
-
-      /* Line ending in EOF instead of \n still counts as a whole line. */
-
-      ffelex_finish_statement_ ();
-      ffewhere_line_kill (ffelex_current_wl_);
-      ffewhere_column_kill (ffelex_current_wc_);
-      return (ffelexHandler) ffelex_handler_;
-    }
-
-  ffelex_next_line_ ();
-
-  ffelex_bad_line_ = FALSE;
-
-  /* Skip over comment (and otherwise ignored) lines as quickly as possible! */
-
-  while (((lextype = ffelex_first_char_[c]) == FFELEX_typeCOMMENT)
-	 || (lextype == FFELEX_typeERROR)
-	 || (lextype == FFELEX_typeSLASH)
-	 || (lextype == FFELEX_typeHASH))
-    {
-      /* Test most frequent type of line first, etc.  */
-      if ((lextype == FFELEX_typeCOMMENT)
-	  || ((lextype == FFELEX_typeSLASH)
-	      && ((c = getc (f)) == '*')))	/* NOTE SIDE-EFFECT. */
-	{
-	  /* Typical case (straight comment), just ignore rest of line. */
-	comment_line:		/* :::::::::::::::::::: */
-
-	  while ((c != '\n') && (c != EOF))
-	    c = getc (f);
-	}
-      else if (lextype == FFELEX_typeHASH)
-	c = ffelex_hash_ (f);
-      else if (lextype == FFELEX_typeSLASH)
-	{
-	  /* SIDE-EFFECT ABOVE HAS HAPPENED. */
-	  ffelex_card_image_[0] = '/';
-	  ffelex_card_image_[1] = c;
-	  column = 2;
-	  goto bad_first_character;	/* :::::::::::::::::::: */
-	}
-      else
-	/* typeERROR or unsupported typeHASH.  */
-	{			/* Bad first character, get line and display
-				   it with message. */
-	  column = ffelex_image_char_ (c, 0);
-
-	bad_first_character:	/* :::::::::::::::::::: */
-
-	  ffelex_bad_line_ = TRUE;
-	  while (((c = getc (f)) != '\n') && (c != EOF))
-	    column = ffelex_image_char_ (c, column);
-	  ffelex_card_image_[column] = '\0';
-	  ffelex_card_length_ = column;
-	  ffelex_bad_1_ (FFEBAD_FIRST_CHAR_INVALID,
-			 ffelex_linecount_current_, 1);
-	}
-
-      /* Read past last char in line.  */
-
-      if (c == EOF)
-	{
-	  ffelex_next_line_ ();
-	  goto end_of_file;	/* :::::::::::::::::::: */
-	}
-
-      c = getc (f);
-
-      ffelex_next_line_ ();
-
-      if (c == EOF)
-	goto end_of_file;	/* :::::::::::::::::::: */
-
-      ffelex_bad_line_ = FALSE;
-    }				/* while [c, first char, means comment] */
-
-  ffelex_saw_tab_
-    = (c == '&')
-      || (ffelex_final_nontab_column_ == 0);
-
-  if (lextype == FFELEX_typeDEBUG)
-    c = ' ';			/* A 'D' or 'd' in column 1 with the
-				   debug-lines option on. */
-
-  column = ffelex_image_char_ (c, 0);
-
-  /* Read the entire line in as is (with whitespace processing).  */
-
-  while (((c = getc (f)) != '\n') && (c != EOF))
-    column = ffelex_image_char_ (c, column);
-
-  if (ffelex_bad_line_)
-    {
-      ffelex_card_image_[column] = '\0';
-      ffelex_card_length_ = column;
-      goto comment_line;		/* :::::::::::::::::::: */
-    }
-
-  /* If no tab, cut off line after column 72/132.  */
-
-  if (!ffelex_saw_tab_ && (column > ffelex_final_nontab_column_))
-    {
-      /* Technically, we should now fill ffelex_card_image_ up thru column
-	 72/132 with spaces, since character/hollerith constants must count
-	 them in that manner. To save CPU time in several ways (avoid a loop
-	 here that would be used only when we actually end a line in
-	 character-constant mode; avoid writing memory unnecessarily; avoid a
-	 loop later checking spaces when not scanning for character-constant
-	 characters), we don't do this, and we do the appropriate thing when
-	 we encounter end-of-line while actually processing a character
-	 constant. */
-
-      column = ffelex_final_nontab_column_;
-    }
-
-  ffelex_card_image_[column] = '\0';
-  ffelex_card_length_ = column;
-
-  /* Save next char in file so we can use register-based c while analyzing
-     line we just read. */
-
-  latest_char_in_file = c;	/* Should be either '\n' or EOF. */
-
-  have_content = FALSE;
-
-  /* Handle label, if any. */
-
-  labi = 0;
-  first_label_char = FFEWHERE_columnUNKNOWN;
-  for (column = 0; column < 5; ++column)
-    {
-      switch (c = ffelex_card_image_[column])
-	{
-	case '\0':
-	case '!':
-	  goto stop_looking;	/* :::::::::::::::::::: */
-
-	case ' ':
-	  break;
-
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	  label_string[labi++] = c;
-	  if (first_label_char == FFEWHERE_columnUNKNOWN)
-	    first_label_char = column + 1;
-	  break;
-
-	case '&':
-	  if (column != 0)
-	    {
-	      ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
-			     ffelex_linecount_current_,
-			     column + 1);
-	      goto beginning_of_line_again;	/* :::::::::::::::::::: */
-	    }
-	  if (ffe_is_pedantic ())
-	    ffelex_bad_1_ (FFEBAD_AMPERSAND,
-			   ffelex_linecount_current_, 1);
-	  finish_statement = FALSE;
-	  just_do_label = FALSE;
-	  goto got_a_continuation;	/* :::::::::::::::::::: */
-
-	case '/':
-	  if (ffelex_card_image_[column + 1] == '*')
-	    goto stop_looking;	/* :::::::::::::::::::: */
-	  /* Fall through. */
-	default:
-	  ffelex_bad_1_ (FFEBAD_LABEL_FIELD_NOT_NUMERIC,
-			 ffelex_linecount_current_, column + 1);
-	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
-	}
-    }
-
- stop_looking:			/* :::::::::::::::::::: */
-
-  label_string[labi] = '\0';
-
-  /* Find first nonblank char starting with continuation column. */
-
-  if (column == 5)		/* In which case we didn't see end of line in
-				   label field. */
-    while ((c = ffelex_card_image_[column]) == ' ')
-      ++column;
-
-  /* Now we're trying to figure out whether this is a continuation line and
-     whether there's anything else of substance on the line.  The cases are
-     as follows:
-
-     1. If a line has an explicit continuation character (other than the digit
-     zero), then if it also has a label, the label is ignored and an error
-     message is printed.  Any remaining text on the line is passed to the
-     parser tasks, thus even an all-blank line (possibly with an ignored
-     label) aside from a positive continuation character might have meaning
-     in the midst of a character or hollerith constant.
-
-     2. If a line has no explicit continuation character (that is, it has a
-     space in column 6 and the first non-space character past column 6 is
-     not a digit 0-9), then there are two possibilities:
-
-     A. A label is present and/or a non-space (and non-comment) character
-     appears somewhere after column 6.	Terminate processing of the previous
-     statement, if any, send the new label for the next statement, if any,
-     and start processing a new statement with this non-blank character, if
-     any.
-
-     B. The line is essentially blank, except for a possible comment character.
-     Don't terminate processing of the previous statement and don't pass any
-     characters to the parser tasks, since the line is not flagged as a
-     continuation line.	 We treat it just like a completely blank line.
-
-     3. If a line has a continuation character of zero (0), then we terminate
-     processing of the previous statement, if any, send the new label for the
-     next statement, if any, and start processing a new statement, if any
-     non-blank characters are present.
-
-     If, when checking to see if we should terminate the previous statement, it
-     is found that there is no previous statement but that there is an
-     outstanding label, substitute CONTINUE as the statement for the label
-     and display an error message. */
-
-  finish_statement = FALSE;
-  just_do_label = FALSE;
-
-  switch (c)
-    {
-    case '!':			/* ANSI Fortran 90 says ! in column 6 is
-				   continuation. */
-      /* VXT Fortran says ! anywhere is comment, even column 6. */
-      if (ffe_is_vxt () || (column != 5))
-	goto no_tokens_on_line;	/* :::::::::::::::::::: */
-      goto got_a_continuation;	/* :::::::::::::::::::: */
-
-    case '/':
-      if (ffelex_card_image_[column + 1] != '*')
-	goto some_other_character;	/* :::::::::::::::::::: */
-      /* Fall through. */
-      if (column == 5)
-	{
-	  /* This seems right to do. But it is close to call, since / * starting
-	     in column 6 will thus be interpreted as a continuation line
-	     beginning with '*'. */
-
-	  goto got_a_continuation;/* :::::::::::::::::::: */
-	}
-      /* Fall through. */
-    case '\0':
-      /* End of line.  Therefore may be continued-through line, so handle
-	 pending label as possible to-be-continued and drive end-of-statement
-	 for any previous statement, else treat as blank line. */
-
-     no_tokens_on_line:		/* :::::::::::::::::::: */
-
-      if (ffe_is_pedantic () && (c == '/'))
-	ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
-		       ffelex_linecount_current_, column + 1);
-      if (first_label_char != FFEWHERE_columnUNKNOWN)
-	{			/* Can't be a continued-through line if it
-				   has a label. */
-	  finish_statement = TRUE;
-	  have_content = TRUE;
-	  just_do_label = TRUE;
-	  break;
-	}
-      goto beginning_of_line_again;	/* :::::::::::::::::::: */
-
-    case '0':
-      if (ffe_is_pedantic () && (column != 5))
-	ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
-		       ffelex_linecount_current_, column + 1);
-      finish_statement = TRUE;
-      goto check_for_content;	/* :::::::::::::::::::: */
-
-    case '1':
-    case '2':
-    case '3':
-    case '4':
-    case '5':
-    case '6':
-    case '7':
-    case '8':
-    case '9':
-
-      /* NOTE: This label can be reached directly from the code
-	 that lexes the label field in columns 1-5.  */
-     got_a_continuation:	/* :::::::::::::::::::: */
-
-      if (first_label_char != FFEWHERE_columnUNKNOWN)
-	{
-	  ffelex_bad_2_ (FFEBAD_LABEL_ON_CONTINUATION,
-			 ffelex_linecount_current_,
-			 first_label_char,
-			 ffelex_linecount_current_,
-			 column + 1);
-	  first_label_char = FFEWHERE_columnUNKNOWN;
-	}
-      if (disallow_continuation_line)
-	{
-	  if (!ignore_disallowed_continuation)
-	    ffelex_bad_1_ (FFEBAD_INVALID_CONTINUATION,
-			   ffelex_linecount_current_, column + 1);
-	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
-	}
-      if (ffe_is_pedantic () && (column != 5))
-	ffelex_bad_1_ (FFEBAD_NON_ANSI_CONTINUATION_COLUMN,
-		       ffelex_linecount_current_, column + 1);
-      if ((ffelex_raw_mode_ != 0)
-	  && (((c = ffelex_card_image_[column + 1]) != '\0')
-	      || !ffelex_saw_tab_))
-	{
-	  ++column;
-	  have_content = TRUE;
-	  break;
-	}
-
-     check_for_content:		/* :::::::::::::::::::: */
-
-      while ((c = ffelex_card_image_[++column]) == ' ')
-	;
-      if ((c == '\0')
-	  || (c == '!')
-	  || ((c == '/')
-	      && (ffelex_card_image_[column + 1] == '*')))
-	{
-	  if (ffe_is_pedantic () && (c == '/'))
-	    ffelex_bad_1_ (FFEBAD_NON_ANSI_COMMENT,
-			   ffelex_linecount_current_, column + 1);
-	  just_do_label = TRUE;
-	}
-      else
-	have_content = TRUE;
-      break;
-
-    default:
-
-     some_other_character:	/* :::::::::::::::::::: */
-
-      if (column == 5)
-	goto got_a_continuation;/* :::::::::::::::::::: */
-
-      /* Here is the very normal case of a regular character starting in
-	 column 7 or beyond with a blank in column 6. */
-
-      finish_statement = TRUE;
-      have_content = TRUE;
-      break;
-    }
-
-  if (have_content
-      || (first_label_char != FFEWHERE_columnUNKNOWN))
-    {
-      /* The line has content of some kind, install new end-statement
-	 point for error messages.  Note that "content" includes cases
-	 where there's little apparent content but enough to finish
-	 a statement.  That's because finishing a statement can trigger
-	 an impending INCLUDE, and that requires accurate line info being
-	 maintained by the lexer.  */
-
-      if (finish_statement)
-	ffelex_prepare_eos_ ();	/* Prepare EOS before we move current pointer. */
-
-      ffewhere_line_kill (ffelex_current_wl_);
-      ffewhere_column_kill (ffelex_current_wc_);
-      ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
-      ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
-    }
-
-  /* We delay this for a combination of reasons.  Mainly, it can start
-     INCLUDE processing, and we want to delay that until the lexer's
-     info on the line is coherent.  And we want to delay that until we're
-     sure there's a reason to make that info coherent, to avoid saving
-     lots of useless lines.  */
-
-  if (finish_statement)
-    ffelex_finish_statement_ ();
-
-  /* If label is present, enclose it in a NUMBER token and send it along. */
-
-  if (first_label_char != FFEWHERE_columnUNKNOWN)
-    {
-      assert (ffelex_token_->type == FFELEX_typeNONE);
-      ffelex_token_->type = FFELEX_typeNUMBER;
-      ffelex_append_to_token_ ('\0');	/* Make room for label text. */
-      strcpy (ffelex_token_->text, label_string);
-      ffelex_token_->where_line
-	= ffewhere_line_use (ffelex_current_wl_);
-      ffelex_token_->where_col = ffewhere_column_new (first_label_char);
-      ffelex_token_->length = labi;
-      ffelex_send_token_ ();
-      ++ffelex_label_tokens_;
-    }
-
-  if (just_do_label)
-    goto beginning_of_line;	/* :::::::::::::::::::: */
-
-  /* Here is the main engine for parsing.  c holds the character at column.
-     It is already known that c is not a blank, end of line, or shriek,
-     unless ffelex_raw_mode_ is not 0 (indicating we are in a
-     character/hollerith constant). A partially filled token may already
-     exist in ffelex_token_.  One special case: if, when the end of the line
-     is reached, continuation_line is FALSE and the only token on the line is
-     END, then it is indeed the last statement. We don't look for
-     continuation lines during this program unit in that case. This is
-     according to ANSI. */
-
-  if (ffelex_raw_mode_ != 0)
-    {
-
-    parse_raw_character:	/* :::::::::::::::::::: */
-
-      if (c == '\0')
-	{
-	  ffewhereColumnNumber i;
-
-	  if (ffelex_saw_tab_ || (column >= ffelex_final_nontab_column_))
-	    goto beginning_of_line;	/* :::::::::::::::::::: */
-
-	  /* Pad out line with "virtual" spaces. */
-
-	  for (i = column; i < ffelex_final_nontab_column_; ++i)
-	    ffelex_card_image_[i] = ' ';
-	  ffelex_card_image_[i] = '\0';
-	  ffelex_card_length_ = i;
-	  c = ' ';
-	}
-
-      switch (ffelex_raw_mode_)
-	{
-	case -3:
-	  c = ffelex_backslash_ (c, column);
-	  if (c == EOF)
-	    break;
-
-	  if (!ffelex_backslash_reconsider_)
-	    ffelex_append_to_token_ (c);
-	  ffelex_raw_mode_ = -1;
-	  break;
-
-	case -2:
-	  if (c == ffelex_raw_char_)
-	    {
-	      ffelex_raw_mode_ = -1;
-	      ffelex_append_to_token_ (c);
-	    }
-	  else
-	    {
-	      ffelex_raw_mode_ = 0;
-	      ffelex_backslash_reconsider_ = TRUE;
-	    }
-	  break;
-
-	case -1:
-	  if (c == ffelex_raw_char_)
-	    ffelex_raw_mode_ = -2;
-	  else
-	    {
-	      c = ffelex_backslash_ (c, column);
-	      if (c == EOF)
-		{
-		  ffelex_raw_mode_ = -3;
-		  break;
-		}
-
-	      ffelex_append_to_token_ (c);
-	    }
-	  break;
-
-	default:
-	  c = ffelex_backslash_ (c, column);
-	  if (c == EOF)
-	    break;
-
-	  if (!ffelex_backslash_reconsider_)
-	    {
-	      ffelex_append_to_token_ (c);
-	      --ffelex_raw_mode_;
-	    }
-	  break;
-	}
-
-      if (ffelex_backslash_reconsider_)
-	ffelex_backslash_reconsider_ = FALSE;
-      else
-	c = ffelex_card_image_[++column];
-
-      if (ffelex_raw_mode_ == 0)
-	{
-	  ffelex_send_token_ ();
-	  assert (ffelex_raw_mode_ == 0);
-	  while (c == ' ')
-	    c = ffelex_card_image_[++column];
-	  if ((c == '\0')
-	      || (c == '!')
-	      || ((c == '/')
-		  && (ffelex_card_image_[column + 1] == '*')))
-	    goto beginning_of_line;	/* :::::::::::::::::::: */
-	  goto parse_nonraw_character;	/* :::::::::::::::::::: */
-	}
-      goto parse_raw_character;	/* :::::::::::::::::::: */
-    }
-
- parse_nonraw_character:	/* :::::::::::::::::::: */
-
-  switch (ffelex_token_->type)
-    {
-    case FFELEX_typeNONE:
-      switch (c)
-	{
-	case '\"':
-	  ffelex_token_->type = FFELEX_typeQUOTE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '$':
-	  ffelex_token_->type = FFELEX_typeDOLLAR;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '%':
-	  ffelex_token_->type = FFELEX_typePERCENT;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '&':
-	  ffelex_token_->type = FFELEX_typeAMPERSAND;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '\'':
-	  ffelex_token_->type = FFELEX_typeAPOSTROPHE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '(':
-	  ffelex_token_->type = FFELEX_typeOPEN_PAREN;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case ')':
-	  ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '*':
-	  ffelex_token_->type = FFELEX_typeASTERISK;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '+':
-	  ffelex_token_->type = FFELEX_typePLUS;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case ',':
-	  ffelex_token_->type = FFELEX_typeCOMMA;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '-':
-	  ffelex_token_->type = FFELEX_typeMINUS;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '.':
-	  ffelex_token_->type = FFELEX_typePERIOD;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '/':
-	  ffelex_token_->type = FFELEX_typeSLASH;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	  ffelex_token_->type
-	    = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	case ':':
-	  ffelex_token_->type = FFELEX_typeCOLON;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case ';':
-	  ffelex_token_->type = FFELEX_typeSEMICOLON;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_permit_include_ = TRUE;
-	  ffelex_send_token_ ();
-	  ffelex_permit_include_ = FALSE;
-	  break;
-
-	case '<':
-	  ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '=':
-	  ffelex_token_->type = FFELEX_typeEQUALS;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '>':
-	  ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '?':
-	  ffelex_token_->type = FFELEX_typeQUESTION;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '_':
-	  if (1 || ffe_is_90 ())
-	    {
-	      ffelex_token_->type = FFELEX_typeUNDERSCORE;
-	      ffelex_token_->where_line
-		= ffewhere_line_use (ffelex_current_wl_);
-	      ffelex_token_->where_col
-		= ffewhere_column_new (column + 1);
-	      ffelex_send_token_ ();
-	      break;
-	    }
-	  /* Fall through. */
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  c = ffesrc_char_source (c);
-
-	  if (ffesrc_char_match_init (c, 'H', 'h')
-	      && ffelex_expecting_hollerith_ != 0)
-	    {
-	      ffelex_raw_mode_ = ffelex_expecting_hollerith_;
-	      ffelex_token_->type = FFELEX_typeHOLLERITH;
-	      ffelex_token_->where_line = ffelex_raw_where_line_;
-	      ffelex_token_->where_col = ffelex_raw_where_col_;
-	      ffelex_raw_where_line_ = ffewhere_line_unknown ();
-	      ffelex_raw_where_col_ = ffewhere_column_unknown ();
-	      c = ffelex_card_image_[++column];
-	      goto parse_raw_character;	/* :::::::::::::::::::: */
-	    }
-
-	  if (ffelex_names_)
-	    {
-	      ffelex_token_->where_line
-		= ffewhere_line_use (ffelex_token_->currentnames_line
-				     = ffewhere_line_use (ffelex_current_wl_));
-	      ffelex_token_->where_col
-		= ffewhere_column_use (ffelex_token_->currentnames_col
-				       = ffewhere_column_new (column + 1));
-	      ffelex_token_->type = FFELEX_typeNAMES;
-	    }
-	  else
-	    {
-	      ffelex_token_->where_line
-		= ffewhere_line_use (ffelex_current_wl_);
-	      ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	      ffelex_token_->type = FFELEX_typeNAME;
-	    }
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
-			 ffelex_linecount_current_, column + 1);
-	  ffelex_finish_statement_ ();
-	  disallow_continuation_line = TRUE;
-	  ignore_disallowed_continuation = TRUE;
-	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeNAME:
-      switch (c)
-	{
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  c = ffesrc_char_source (c);
-	  /* Fall through.  */
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	case '_':
-	case '$':
-	  if ((c == '$')
-	      && !ffe_is_dollar_ok ())
-	    {
-	      ffelex_send_token_ ();
-	      goto parse_next_character;	/* :::::::::::::::::::: */
-	    }
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeNAMES:
-      switch (c)
-	{
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  c = ffesrc_char_source (c);
-	  /* Fall through.  */
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	case '_':
-	case '$':
-	  if ((c == '$')
-	      && !ffe_is_dollar_ok ())
-	    {
-	      ffelex_send_token_ ();
-	      goto parse_next_character;	/* :::::::::::::::::::: */
-	    }
-	  if (ffelex_token_->length < FFEWHERE_indexMAX)
-	    {
-	      ffewhere_track (&ffelex_token_->currentnames_line,
-			      &ffelex_token_->currentnames_col,
-			      ffelex_token_->wheretrack,
-			      ffelex_token_->length,
-			      ffelex_linecount_current_,
-			      column + 1);
-	    }
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeNUMBER:
-      switch (c)
-	{
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeASTERISK:
-      switch (c)
-	{
-	case '*':		/* ** */
-	  ffelex_token_->type = FFELEX_typePOWER;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:		/* * not followed by another *. */
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeCOLON:
-      switch (c)
-	{
-	case ':':		/* :: */
-	  ffelex_token_->type = FFELEX_typeCOLONCOLON;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:		/* : not followed by another :. */
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeSLASH:
-      switch (c)
-	{
-	case '/':		/* // */
-	  ffelex_token_->type = FFELEX_typeCONCAT;
-	  ffelex_send_token_ ();
-	  break;
-
-	case ')':		/* /) */
-	  ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
-	  ffelex_send_token_ ();
-	  break;
-
-	case '=':		/* /= */
-	  ffelex_token_->type = FFELEX_typeREL_NE;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeOPEN_PAREN:
-      switch (c)
-	{
-	case '/':		/* (/ */
-	  ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeOPEN_ANGLE:
-      switch (c)
-	{
-	case '=':		/* <= */
-	  ffelex_token_->type = FFELEX_typeREL_LE;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeEQUALS:
-      switch (c)
-	{
-	case '=':		/* == */
-	  ffelex_token_->type = FFELEX_typeREL_EQ;
-	  ffelex_send_token_ ();
-	  break;
-
-	case '>':		/* => */
-	  ffelex_token_->type = FFELEX_typePOINTS;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeCLOSE_ANGLE:
-      switch (c)
-	{
-	case '=':		/* >= */
-	  ffelex_token_->type = FFELEX_typeREL_GE;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    default:
-      assert ("Serious error!!" == NULL);
-      abort ();
-      break;
-    }
-
-  c = ffelex_card_image_[++column];
-
- parse_next_character:		/* :::::::::::::::::::: */
-
-  if (ffelex_raw_mode_ != 0)
-    goto parse_raw_character;	/* :::::::::::::::::::: */
-
-  while (c == ' ')
-    c = ffelex_card_image_[++column];
-
-  if ((c == '\0')
-      || (c == '!')
-      || ((c == '/')
-	  && (ffelex_card_image_[column + 1] == '*')))
-    {
-      if ((ffelex_number_of_tokens_ == ffelex_label_tokens_)
-	  && (ffelex_token_->type == FFELEX_typeNAMES)
-	  && (ffelex_token_->length == 3)
-	  && (ffesrc_strncmp_2c (ffe_case_match (),
-				 ffelex_token_->text,
-				 "END", "end", "End",
-				 3)
-	   == 0))
-	{
-	  ffelex_finish_statement_ ();
-	  disallow_continuation_line = TRUE;
-	  ignore_disallowed_continuation = FALSE;
-	  goto beginning_of_line_again;	/* :::::::::::::::::::: */
-	}
-      goto beginning_of_line;	/* :::::::::::::::::::: */
-    }
-  goto parse_nonraw_character;	/* :::::::::::::::::::: */
-}
-
-/* ffelex_file_free -- Lex a given file in free source form
-
-   ffewhere wf;
-   FILE *f;
-   ffelex_file_free(wf,f);
-
-   Lexes the file according to Fortran 90 ANSI + VXT specifications.  */
-
-ffelexHandler
-ffelex_file_free (ffewhereFile wf, FILE *f)
-{
-  register int c = 0;		/* Character currently under consideration. */
-  register ffewhereColumnNumber column = 0;	/* Not really; 0 means column 1... */
-  bool continuation_line = FALSE;
-  ffewhereColumnNumber continuation_column;
-  int latest_char_in_file = 0;	/* For getting back into comment-skipping
-				   code. */
-
-  /* Lex is called for a particular file, not for a particular program unit.
-     Yet the two events do share common characteristics.  The first line in a
-     file or in a program unit cannot be a continuation line.  No token can
-     be in mid-formation.  No current label for the statement exists, since
-     there is no current statement. */
-
-  assert (ffelex_handler_ != NULL);
-
-  input_line = 0;
-  input_filename = ffewhere_file_name (wf);
-  ffelex_current_wf_ = wf;
-  continuation_line = FALSE;
-  ffelex_token_->type = FFELEX_typeNONE;
-  ffelex_number_of_tokens_ = 0;
-  ffelex_current_wl_ = ffewhere_line_unknown ();
-  ffelex_current_wc_ = ffewhere_column_unknown ();
-  latest_char_in_file = '\n';
-
-  /* Come here to get a new line. */
-
- beginning_of_line:		/* :::::::::::::::::::: */
-
-  c = latest_char_in_file;
-  if ((c == EOF) || ((c = ffelex_getc_ (f)) == EOF))
-    {
-
-     end_of_file:		/* :::::::::::::::::::: */
-
-      /* Line ending in EOF instead of \n still counts as a whole line. */
-
-      ffelex_finish_statement_ ();
-      ffewhere_line_kill (ffelex_current_wl_);
-      ffewhere_column_kill (ffelex_current_wc_);
-      return (ffelexHandler) ffelex_handler_;
-    }
-
-  ffelex_next_line_ ();
-
-  ffelex_bad_line_ = FALSE;
-
-  /* Skip over initial-comment and empty lines as quickly as possible! */
-
-  while ((c == '\n')
-	 || (c == '!')
-	 || (c == '#'))
-    {
-      if (c == '#')
-	c = ffelex_hash_ (f);
-
-     comment_line:		/* :::::::::::::::::::: */
-
-      while ((c != '\n') && (c != EOF))
-	c = getc (f);
-
-      if (c == EOF)
-	{
-	  ffelex_next_line_ ();
-	  goto end_of_file;	/* :::::::::::::::::::: */
-	}
-
-      c = getc (f);
-
-      ffelex_next_line_ ();
-
-      if (c == EOF)
-	goto end_of_file;	/* :::::::::::::::::::: */
-    }
-
-  ffelex_saw_tab_ = FALSE;
-
-  column = ffelex_image_char_ (c, 0);
-
-  /* Read the entire line in as is (with whitespace processing).  */
-
-  while (((c = getc (f)) != '\n') && (c != EOF))
-    column = ffelex_image_char_ (c, column);
-
-  if (ffelex_bad_line_)
-    {
-      ffelex_card_image_[column] = '\0';
-      ffelex_card_length_ = column;
-      goto comment_line;		/* :::::::::::::::::::: */
-    }
-
-  /* If no tab, cut off line after column 132.  */
-
-  if (!ffelex_saw_tab_ && (column > FFELEX_FREE_MAX_COLUMNS_))
-    column = FFELEX_FREE_MAX_COLUMNS_;
-
-  ffelex_card_image_[column] = '\0';
-  ffelex_card_length_ = column;
-
-  /* Save next char in file so we can use register-based c while analyzing
-     line we just read. */
-
-  latest_char_in_file = c;	/* Should be either '\n' or EOF. */
-
-  column = 0;
-  continuation_column = 0;
-
-  /* Skip over initial spaces to see if the first nonblank character
-     is exclamation point, newline, or EOF (line is therefore a comment) or
-     ampersand (line is therefore a continuation line). */
-
-  while ((c = ffelex_card_image_[column]) == ' ')
-    ++column;
-
-  switch (c)
-    {
-    case '!':
-    case '\0':
-      goto beginning_of_line;	/* :::::::::::::::::::: */
-
-    case '&':
-      continuation_column = column + 1;
-      break;
-
-    default:
-      break;
-    }
-
-  /* The line definitely has content of some kind, install new end-statement
-     point for error messages. */
-
-  ffewhere_line_kill (ffelex_current_wl_);
-  ffewhere_column_kill (ffelex_current_wc_);
-  ffelex_current_wl_ = ffewhere_line_new (ffelex_linecount_current_);
-  ffelex_current_wc_ = ffewhere_column_new (ffelex_card_length_ + 1);
-
-  /* Figure out which column to start parsing at. */
-
-  if (continuation_line)
-    {
-      if (continuation_column == 0)
-	{
-	  if (ffelex_raw_mode_ != 0)
-	    {
-	      ffelex_bad_1_ (FFEBAD_BAD_CHAR_CONTINUE,
-			     ffelex_linecount_current_, column + 1);
-	    }
-	  else if (ffelex_token_->type != FFELEX_typeNONE)
-	    {
-	      ffelex_bad_1_ (FFEBAD_BAD_LEXTOK_CONTINUE,
-			     ffelex_linecount_current_, column + 1);
-	    }
-	}
-      else if (ffelex_is_free_char_ctx_contin_ (continuation_column))
-	{			/* Line contains only a single "&" as only
-				   nonblank character. */
-	  ffelex_bad_1_ (FFEBAD_BAD_FREE_CONTINUE,
-			 ffelex_linecount_current_, continuation_column);
-	  goto beginning_of_line;	/* :::::::::::::::::::: */
-	}
-      column = continuation_column;
-    }
-  else
-    column = 0;
-
-  c = ffelex_card_image_[column];
-  continuation_line = FALSE;
-
-  /* Here is the main engine for parsing.  c holds the character at column.
-     It is already known that c is not a blank, end of line, or shriek,
-     unless ffelex_raw_mode_ is not 0 (indicating we are in a
-     character/hollerith constant).  A partially filled token may already
-     exist in ffelex_token_. */
-
-  if (ffelex_raw_mode_ != 0)
-    {
-
-    parse_raw_character:	/* :::::::::::::::::::: */
-
-      switch (c)
-	{
-	case '&':
-	  if (ffelex_is_free_char_ctx_contin_ (column + 1))
-	    {
-	      continuation_line = TRUE;
-	      goto beginning_of_line;	/* :::::::::::::::::::: */
-	    }
-	  break;
-
-	case '\0':
-	  ffelex_finish_statement_ ();
-	  goto beginning_of_line;	/* :::::::::::::::::::: */
-
-	default:
-	  break;
-	}
-
-      switch (ffelex_raw_mode_)
-	{
-	case -3:
-	  c = ffelex_backslash_ (c, column);
-	  if (c == EOF)
-	    break;
-
-	  if (!ffelex_backslash_reconsider_)
-	    ffelex_append_to_token_ (c);
-	  ffelex_raw_mode_ = -1;
-	  break;
-
-	case -2:
-	  if (c == ffelex_raw_char_)
-	    {
-	      ffelex_raw_mode_ = -1;
-	      ffelex_append_to_token_ (c);
-	    }
-	  else
-	    {
-	      ffelex_raw_mode_ = 0;
-	      ffelex_backslash_reconsider_ = TRUE;
-	    }
-	  break;
-
-	case -1:
-	  if (c == ffelex_raw_char_)
-	    ffelex_raw_mode_ = -2;
-	  else
-	    {
-	      c = ffelex_backslash_ (c, column);
-	      if (c == EOF)
-		{
-		  ffelex_raw_mode_ = -3;
-		  break;
-		}
-
-	      ffelex_append_to_token_ (c);
-	    }
-	  break;
-
-	default:
-	  c = ffelex_backslash_ (c, column);
-	  if (c == EOF)
-	    break;
-
-	  if (!ffelex_backslash_reconsider_)
-	    {
-	      ffelex_append_to_token_ (c);
-	      --ffelex_raw_mode_;
-	    }
-	  break;
-	}
-
-      if (ffelex_backslash_reconsider_)
-	ffelex_backslash_reconsider_ = FALSE;
-      else
-	c = ffelex_card_image_[++column];
-
-      if (ffelex_raw_mode_ == 0)
-	{
-	  ffelex_send_token_ ();
-	  assert (ffelex_raw_mode_ == 0);
-	  while (c == ' ')
-	    c = ffelex_card_image_[++column];
-	  if ((c == '\0') || (c == '!'))
-	    {
-	      ffelex_finish_statement_ ();
-	      goto beginning_of_line;	/* :::::::::::::::::::: */
-	    }
-	  if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
-	    {
-	      continuation_line = TRUE;
-	      goto beginning_of_line;	/* :::::::::::::::::::: */
-	    }
-	  goto parse_nonraw_character_noncontin;	/* :::::::::::::::::::: */
-	}
-      goto parse_raw_character;	/* :::::::::::::::::::: */
-    }
-
- parse_nonraw_character:	/* :::::::::::::::::::: */
-
-  if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
-    {
-      continuation_line = TRUE;
-      goto beginning_of_line;	/* :::::::::::::::::::: */
-    }
-
- parse_nonraw_character_noncontin:	/* :::::::::::::::::::: */
-
-  switch (ffelex_token_->type)
-    {
-    case FFELEX_typeNONE:
-      if (c == ' ')
-	{			/* Otherwise
-				   finish-statement/continue-statement
-				   already checked. */
-	  while (c == ' ')
-	    c = ffelex_card_image_[++column];
-	  if ((c == '\0') || (c == '!'))
-	    {
-	      ffelex_finish_statement_ ();
-	      goto beginning_of_line;	/* :::::::::::::::::::: */
-	    }
-	  if ((c == '&') && ffelex_is_free_nonc_ctx_contin_ (column + 1))
-	    {
-	      continuation_line = TRUE;
-	      goto beginning_of_line;	/* :::::::::::::::::::: */
-	    }
-	}
-
-      switch (c)
-	{
-	case '\"':
-	  ffelex_token_->type = FFELEX_typeQUOTE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '$':
-	  ffelex_token_->type = FFELEX_typeDOLLAR;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '%':
-	  ffelex_token_->type = FFELEX_typePERCENT;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '&':
-	  ffelex_token_->type = FFELEX_typeAMPERSAND;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '\'':
-	  ffelex_token_->type = FFELEX_typeAPOSTROPHE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '(':
-	  ffelex_token_->type = FFELEX_typeOPEN_PAREN;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case ')':
-	  ffelex_token_->type = FFELEX_typeCLOSE_PAREN;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '*':
-	  ffelex_token_->type = FFELEX_typeASTERISK;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '+':
-	  ffelex_token_->type = FFELEX_typePLUS;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case ',':
-	  ffelex_token_->type = FFELEX_typeCOMMA;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '-':
-	  ffelex_token_->type = FFELEX_typeMINUS;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '.':
-	  ffelex_token_->type = FFELEX_typePERIOD;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '/':
-	  ffelex_token_->type = FFELEX_typeSLASH;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	  ffelex_token_->type
-	    = ffelex_hexnum_ ? FFELEX_typeNAME : FFELEX_typeNUMBER;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	case ':':
-	  ffelex_token_->type = FFELEX_typeCOLON;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case ';':
-	  ffelex_token_->type = FFELEX_typeSEMICOLON;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_permit_include_ = TRUE;
-	  ffelex_send_token_ ();
-	  ffelex_permit_include_ = FALSE;
-	  break;
-
-	case '<':
-	  ffelex_token_->type = FFELEX_typeOPEN_ANGLE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '=':
-	  ffelex_token_->type = FFELEX_typeEQUALS;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '>':
-	  ffelex_token_->type = FFELEX_typeCLOSE_ANGLE;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  break;
-
-	case '?':
-	  ffelex_token_->type = FFELEX_typeQUESTION;
-	  ffelex_token_->where_line = ffewhere_line_use (ffelex_current_wl_);
-	  ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	  ffelex_send_token_ ();
-	  break;
-
-	case '_':
-	  if (1 || ffe_is_90 ())
-	    {
-	      ffelex_token_->type = FFELEX_typeUNDERSCORE;
-	      ffelex_token_->where_line
-		= ffewhere_line_use (ffelex_current_wl_);
-	      ffelex_token_->where_col
-		= ffewhere_column_new (column + 1);
-	      ffelex_send_token_ ();
-	      break;
-	    }
-	  /* Fall through. */
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  c = ffesrc_char_source (c);
-
-	  if (ffesrc_char_match_init (c, 'H', 'h')
-	      && ffelex_expecting_hollerith_ != 0)
-	    {
-	      ffelex_raw_mode_ = ffelex_expecting_hollerith_;
-	      ffelex_token_->type = FFELEX_typeHOLLERITH;
-	      ffelex_token_->where_line = ffelex_raw_where_line_;
-	      ffelex_token_->where_col = ffelex_raw_where_col_;
-	      ffelex_raw_where_line_ = ffewhere_line_unknown ();
-	      ffelex_raw_where_col_ = ffewhere_column_unknown ();
-	      c = ffelex_card_image_[++column];
-	      goto parse_raw_character;	/* :::::::::::::::::::: */
-	    }
-
-	  if (ffelex_names_pure_)
-	    {
-	      ffelex_token_->where_line
-		= ffewhere_line_use (ffelex_token_->currentnames_line
-				     = ffewhere_line_use (ffelex_current_wl_));
-	      ffelex_token_->where_col
-		= ffewhere_column_use (ffelex_token_->currentnames_col
-				       = ffewhere_column_new (column + 1));
-	      ffelex_token_->type = FFELEX_typeNAMES;
-	    }
-	  else
-	    {
-	      ffelex_token_->where_line
-		= ffewhere_line_use (ffelex_current_wl_);
-	      ffelex_token_->where_col = ffewhere_column_new (column + 1);
-	      ffelex_token_->type = FFELEX_typeNAME;
-	    }
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_bad_1_ (FFEBAD_UNRECOGNIZED_CHARACTER,
-			 ffelex_linecount_current_, column + 1);
-	  ffelex_finish_statement_ ();
-	  goto beginning_of_line;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeNAME:
-      switch (c)
-	{
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  c = ffesrc_char_source (c);
-	  /* Fall through.  */
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	case '_':
-	case '$':
-	  if ((c == '$')
-	      && !ffe_is_dollar_ok ())
-	    {
-	      ffelex_send_token_ ();
-	      goto parse_next_character;	/* :::::::::::::::::::: */
-	    }
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeNAMES:
-      switch (c)
-	{
-	case 'A':
-	case 'B':
-	case 'C':
-	case 'D':
-	case 'E':
-	case 'F':
-	case 'G':
-	case 'H':
-	case 'I':
-	case 'J':
-	case 'K':
-	case 'L':
-	case 'M':
-	case 'N':
-	case 'O':
-	case 'P':
-	case 'Q':
-	case 'R':
-	case 'S':
-	case 'T':
-	case 'U':
-	case 'V':
-	case 'W':
-	case 'X':
-	case 'Y':
-	case 'Z':
-	case 'a':
-	case 'b':
-	case 'c':
-	case 'd':
-	case 'e':
-	case 'f':
-	case 'g':
-	case 'h':
-	case 'i':
-	case 'j':
-	case 'k':
-	case 'l':
-	case 'm':
-	case 'n':
-	case 'o':
-	case 'p':
-	case 'q':
-	case 'r':
-	case 's':
-	case 't':
-	case 'u':
-	case 'v':
-	case 'w':
-	case 'x':
-	case 'y':
-	case 'z':
-	  c = ffesrc_char_source (c);
-	  /* Fall through.  */
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	case '_':
-	case '$':
-	  if ((c == '$')
-	      && !ffe_is_dollar_ok ())
-	    {
-	      ffelex_send_token_ ();
-	      goto parse_next_character;	/* :::::::::::::::::::: */
-	    }
-	  if (ffelex_token_->length < FFEWHERE_indexMAX)
-	    {
-	      ffewhere_track (&ffelex_token_->currentnames_line,
-			      &ffelex_token_->currentnames_col,
-			      ffelex_token_->wheretrack,
-			      ffelex_token_->length,
-			      ffelex_linecount_current_,
-			      column + 1);
-	    }
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeNUMBER:
-      switch (c)
-	{
-	case '0':
-	case '1':
-	case '2':
-	case '3':
-	case '4':
-	case '5':
-	case '6':
-	case '7':
-	case '8':
-	case '9':
-	  ffelex_append_to_token_ (c);
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeASTERISK:
-      switch (c)
-	{
-	case '*':		/* ** */
-	  ffelex_token_->type = FFELEX_typePOWER;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:		/* * not followed by another *. */
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeCOLON:
-      switch (c)
-	{
-	case ':':		/* :: */
-	  ffelex_token_->type = FFELEX_typeCOLONCOLON;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:		/* : not followed by another :. */
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeSLASH:
-      switch (c)
-	{
-	case '/':		/* // */
-	  ffelex_token_->type = FFELEX_typeCONCAT;
-	  ffelex_send_token_ ();
-	  break;
-
-	case ')':		/* /) */
-	  ffelex_token_->type = FFELEX_typeCLOSE_ARRAY;
-	  ffelex_send_token_ ();
-	  break;
-
-	case '=':		/* /= */
-	  ffelex_token_->type = FFELEX_typeREL_NE;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeOPEN_PAREN:
-      switch (c)
-	{
-	case '/':		/* (/ */
-	  ffelex_token_->type = FFELEX_typeOPEN_ARRAY;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeOPEN_ANGLE:
-      switch (c)
-	{
-	case '=':		/* <= */
-	  ffelex_token_->type = FFELEX_typeREL_LE;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeEQUALS:
-      switch (c)
-	{
-	case '=':		/* == */
-	  ffelex_token_->type = FFELEX_typeREL_EQ;
-	  ffelex_send_token_ ();
-	  break;
-
-	case '>':		/* => */
-	  ffelex_token_->type = FFELEX_typePOINTS;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    case FFELEX_typeCLOSE_ANGLE:
-      switch (c)
-	{
-	case '=':		/* >= */
-	  ffelex_token_->type = FFELEX_typeREL_GE;
-	  ffelex_send_token_ ();
-	  break;
-
-	default:
-	  ffelex_send_token_ ();
-	  goto parse_next_character;	/* :::::::::::::::::::: */
-	}
-      break;
-
-    default:
-      assert ("Serious error!" == NULL);
-      abort ();
-      break;
-    }
-
-  c = ffelex_card_image_[++column];
-
- parse_next_character:		/* :::::::::::::::::::: */
-
-  if (ffelex_raw_mode_ != 0)
-    goto parse_raw_character;	/* :::::::::::::::::::: */
-
-  if ((c == '\0') || (c == '!'))
-    {
-      ffelex_finish_statement_ ();
-      goto beginning_of_line;	/* :::::::::::::::::::: */
-    }
-  goto parse_nonraw_character;	/* :::::::::::::::::::: */
-}
-
-/* See the code in com.c that calls this to understand why.  */
-
-void
-ffelex_hash_kludge (FILE *finput)
-{
-  /* If you change this constant string, you have to change whatever
-     code might thus be affected by it in terms of having to use
-     ffelex_getc_() instead of getc() in the lexers and _hash_.  */
-  static const char match[] = "# 1 \"";
-  static int kludge[ARRAY_SIZE (match) + 1];
-  int c;
-  const char *p;
-  int *q;
-
-  /* Read chars as long as they match the target string.
-     Copy them into an array that will serve as a record
-     of what we read (essentially a multi-char ungetc(),
-     for code that uses ffelex_getc_ instead of getc() elsewhere
-     in the lexer.  */
-  for (p = &match[0], q = &kludge[0], c = getc (finput);
-       (c == *p) && (*p != '\0') && (c != EOF);
-       ++p, ++q, c = getc (finput))
-    *q = c;
-
-  *q = c;			/* Might be EOF, which requires int. */
-  *++q = 0;
-
-  ffelex_kludge_chars_ = &kludge[0];
-
-  if (*p == 0)
-    {
-      ffelex_kludge_flag_ = TRUE;
-      ++ffelex_kludge_chars_;
-      ffelex_hash_ (finput);	/* Handle it NOW rather than later. */
-      ffelex_kludge_flag_ = FALSE;
-    }
-}
-
-void
-ffelex_init_1 (void)
-{
-  unsigned int i;
-
-  ffelex_final_nontab_column_ = ffe_fixed_line_length ();
-  ffelex_card_size_ = FFELEX_columnINITIAL_SIZE_;
-  ffelex_card_image_ = malloc_new_ksr (malloc_pool_image (),
-				       "FFELEX card image",
-				       FFELEX_columnINITIAL_SIZE_ + 9);
-  ffelex_card_image_[0] = '\0';
-
-  for (i = 0; i < 256; ++i)
-    ffelex_first_char_[i] = FFELEX_typeERROR;
-
-  ffelex_first_char_['\t'] = FFELEX_typeRAW;
-  ffelex_first_char_['\n'] = FFELEX_typeCOMMENT;
-  ffelex_first_char_['\v'] = FFELEX_typeCOMMENT;
-  ffelex_first_char_['\f'] = FFELEX_typeCOMMENT;
-  ffelex_first_char_['\r'] = FFELEX_typeRAW;
-  ffelex_first_char_[' '] = FFELEX_typeRAW;
-  ffelex_first_char_['!'] = FFELEX_typeCOMMENT;
-  ffelex_first_char_['*'] = FFELEX_typeCOMMENT;
-  ffelex_first_char_['/'] = FFELEX_typeSLASH;
-  ffelex_first_char_['&'] = FFELEX_typeRAW;
-  ffelex_first_char_['#'] = FFELEX_typeHASH;
-
-  for (i = '0'; i <= '9'; ++i)
-    ffelex_first_char_[i] = FFELEX_typeRAW;
-
-  if ((ffe_case_match () == FFE_caseNONE)
-      || ((ffe_case_match () == FFE_caseUPPER)
-	  && (ffe_case_source () != FFE_caseLOWER))	/* Idiot!  :-) */
-      || ((ffe_case_match () == FFE_caseLOWER)
-	  && (ffe_case_source () == FFE_caseLOWER)))
-    {
-      ffelex_first_char_['C'] = FFELEX_typeCOMMENT;
-      ffelex_first_char_['D'] = FFELEX_typeCOMMENT;
-    }
-  if ((ffe_case_match () == FFE_caseNONE)
-      || ((ffe_case_match () == FFE_caseLOWER)
-	  && (ffe_case_source () != FFE_caseUPPER))	/* Idiot!  :-) */
-      || ((ffe_case_match () == FFE_caseUPPER)
-	  && (ffe_case_source () == FFE_caseUPPER)))
-    {
-      ffelex_first_char_['c'] = FFELEX_typeCOMMENT;
-      ffelex_first_char_['d'] = FFELEX_typeCOMMENT;
-    }
-
-  ffelex_linecount_current_ = 0;
-  ffelex_linecount_next_ = 1;
-  ffelex_raw_mode_ = 0;
-  ffelex_set_include_ = FALSE;
-  ffelex_permit_include_ = FALSE;
-  ffelex_names_ = TRUE;		/* First token in program is a names. */
-  ffelex_names_pure_ = FALSE;	/* Free-form lexer does NAMES only for
-				   FORMAT. */
-  ffelex_hexnum_ = FALSE;
-  ffelex_expecting_hollerith_ = 0;
-  ffelex_raw_where_line_ = ffewhere_line_unknown ();
-  ffelex_raw_where_col_ = ffewhere_column_unknown ();
-
-  ffelex_token_ = ffelex_token_new_ ();
-  ffelex_token_->type = FFELEX_typeNONE;
-  ffelex_token_->uses = 1;
-  ffelex_token_->where_line = ffewhere_line_unknown ();
-  ffelex_token_->where_col = ffewhere_column_unknown ();
-  ffelex_token_->text = NULL;
-
-  ffelex_handler_ = NULL;
-}
-
-/* ffelex_is_names_expected -- Is the current parser expecting NAMES vs. NAME?
-
-   if (ffelex_is_names_expected())
-       // Deliver NAMES token
-     else
-       // Deliver NAME token
-
-   Must be called while lexer is active, obviously.  */
-
-bool
-ffelex_is_names_expected (void)
-{
-  return ffelex_names_;
-}
-
-/* Current card image, which has the master linecount number
-   ffelex_linecount_current_.  */
-
-char *
-ffelex_line (void)
-{
-  return ffelex_card_image_;
-}
-
-/* ffelex_line_length -- Return length of current lexer line
-
-   printf("Length is %lu\n",ffelex_line_length());
-
-   Must be called while lexer is active, obviously.  */
-
-ffewhereColumnNumber
-ffelex_line_length (void)
-{
-  return ffelex_card_length_;
-}
-
-/* Master line count of current card image, or 0 if no card image
-   is current.  */
-
-ffewhereLineNumber
-ffelex_line_number (void)
-{
-  return ffelex_linecount_current_;
-}
-
-/* ffelex_set_expecting_hollerith -- Set hollerith expectation status
-
-   ffelex_set_expecting_hollerith(0);
-
-   Lex initially assumes no hollerith constant is about to show up.  If
-   syntactic analysis expects one, it should call this function with the
-   number of characters expected in the constant immediately after recognizing
-   the decimal number preceding the "H" and the constant itself.  Then, if
-   the next character is indeed H, the lexer will interpret it as beginning
-   a hollerith constant and ship the token formed by reading the specified
-   number of characters (interpreting blanks and otherwise-comments too)
-   from the input file.	 It is up to syntactic analysis to call this routine
-   again with 0 to turn hollerith detection off immediately upon receiving
-   the token that might or might not be HOLLERITH.
-
-   Also call this after seeing an APOSTROPHE or QUOTE token that begins a
-   character constant.	Pass the expected termination character (apostrophe
-   or quote).
-
-   Pass for length either the length of the hollerith (must be > 0), -1
-   meaning expecting a character constant, or 0 to cancel expectation of
-   a hollerith only after calling it with a length of > 0 and receiving the
-   next token (which may or may not have been a HOLLERITH token).
-
-   Pass for which either an apostrophe or quote when passing length of -1.
-   Else which is a don't-care.
-
-   Pass for line and column the line/column info for the token beginning the
-   character or hollerith constant, for use in error messages, when passing
-   a length of -1 -- this function will invoke ffewhere_line/column_use to
-   make its own copies.	 Else line and column are don't-cares (when length
-   is 0) and the outstanding copies of the previous line/column info, if
-   still around, are killed.
-
-   21-Feb-90  JCB  3.1
-      When called with length of 0, also zero ffelex_raw_mode_.	 This is
-      so ffest_save_ can undo the effects of replaying tokens like
-      APOSTROPHE and QUOTE.
-   25-Jan-90  JCB  3.0
-      New line, column arguments allow error messages to point to the true
-      beginning of a character/hollerith constant, rather than the beginning
-      of the content part, which makes them more consistent and helpful.
-   05-Nov-89  JCB  2.0
-      New "which" argument allows caller to specify termination character,
-      which should be apostrophe or double-quote, to support Fortran 90.  */
-
-void
-ffelex_set_expecting_hollerith (long length, char which,
-				ffewhereLine line, ffewhereColumn column)
-{
-
-  /* First kill the pending line/col info, if any (should only be pending
-     when this call has length==0, the previous call had length>0, and a
-     non-HOLLERITH token was sent in between the calls, but play it safe). */
-
-  ffewhere_line_kill (ffelex_raw_where_line_);
-  ffewhere_column_kill (ffelex_raw_where_col_);
-
-  /* Now handle the length function. */
-  switch (length)
-    {
-    case 0:
-      ffelex_expecting_hollerith_ = 0;
-      ffelex_raw_mode_ = 0;
-      ffelex_raw_where_line_ = ffewhere_line_unknown ();
-      ffelex_raw_where_col_ = ffewhere_column_unknown ();
-      return;			/* Don't set new line/column info from args. */
-
-    case -1:
-      ffelex_raw_mode_ = -1;
-      ffelex_raw_char_ = which;
-      break;
-
-    default:			/* length > 0 */
-      ffelex_expecting_hollerith_ = length;
-      break;
-    }
-
-  /* Now set new line/column information from passed args. */
-
-  ffelex_raw_where_line_ = ffewhere_line_use (line);
-  ffelex_raw_where_col_ = ffewhere_column_use (column);
-}
-
-/* ffelex_set_handler -- Set handler for tokens before calling _fixed or _free
-
-   ffelex_set_handler((ffelexHandler) my_first_handler);
-
-   Must be called before calling ffelex_file_fixed or ffelex_file_free or
-   after they return, but not while they are active.  */
-
-void
-ffelex_set_handler (ffelexHandler first)
-{
-  ffelex_handler_ = first;
-}
-
-/* ffelex_set_hexnum -- Set hexnum flag
-
-   ffelex_set_hexnum(TRUE);
-
-   Lex normally interprets a token starting with [0-9] as a NUMBER token,
-   so if it sees a [A-Za-z] in it, it stops parsing the NUMBER and leaves
-   the character as the first of the next token.  But when parsing a
-   hexadecimal number, by calling this function with TRUE before starting
-   the parse of the token itself, lex will interpret [0-9] as the start
-   of a NAME token.  */
-
-void
-ffelex_set_hexnum (bool f)
-{
-  ffelex_hexnum_ = f;
-}
-
-/* ffelex_set_include -- Set INCLUDE file to be processed next
-
-   ffewhereFile wf;  // The ffewhereFile object for the file.
-   bool free_form;  // TRUE means read free-form file, FALSE fixed-form.
-   FILE *fi;  // The file to INCLUDE.
-   ffelex_set_include(wf,free_form,fi);
-
-   Must be called only after receiving the EOS token following a valid
-   INCLUDE statement specifying a file that has already been successfully
-   opened.  */
-
-void
-ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi)
-{
-  assert (ffelex_permit_include_);
-  assert (!ffelex_set_include_);
-  ffelex_set_include_ = TRUE;
-  ffelex_include_free_form_ = free_form;
-  ffelex_include_file_ = fi;
-  ffelex_include_wherefile_ = wf;
-}
-
-/* ffelex_set_names -- Set names/name flag, names = TRUE
-
-   ffelex_set_names(FALSE);
-
-   Lex initially assumes multiple names should be formed.  If this function is
-   called with FALSE, then single names are formed instead.  The differences
-   are a difference in the token type (FFELEX_typeNAMES vs. FFELEX_typeNAME)
-   and in whether full source-location tracking is performed (it is for
-   multiple names, not for single names), which is more expensive in terms of
-   CPU time.  */
-
-void
-ffelex_set_names (bool f)
-{
-  ffelex_names_ = f;
-  if (!f)
-    ffelex_names_pure_ = FALSE;
-}
-
-/* ffelex_set_names_pure -- Set names/name (pure) flag, names = TRUE
-
-   ffelex_set_names_pure(FALSE);
-
-   Like ffelex_set_names, except affects both lexers.  Normally, the
-   free-form lexer need not generate NAMES tokens because adjacent NAME
-   tokens must be separated by spaces which causes the lexer to generate
-   separate tokens for analysis (whereas in fixed-form the spaces are
-   ignored resulting in one long token).  But in FORMAT statements, for
-   some reason, the Fortran 90 standard specifies that spaces can occur
-   anywhere within a format-item-list with no effect on the format spec
-   (except of course within character string edit descriptors), which means
-   that "1PE14.2" and "1 P E 1 4 . 2" are equivalent.  For the FORMAT
-   statement handling, the existence of spaces makes it hard to deal with,
-   because each token is seen distinctly (i.e. seven tokens in the latter
-   example).  But when no spaces are provided, as in the former example,
-   then only four tokens are generated, NUMBER("1"), NAME("PE14"), PERIOD,
-   NUMBER ("2").  By generating a NAMES instead of NAME, three things happen:
-   One, ffest_kw_format_ does a substring rather than full-string match,
-   and thus matches "PE14" to "PE"; two, ffelex_token_xyz_from_names functions
-   may be used to pull NAME/NAMES and NUMBER tokens out of the NAMES token;
-   and three, error reporting can point to the actual character rather than
-   at or prior to it.  The first two things could be resolved by providing
-   alternate functions fairly easy, thus allowing FORMAT handling to expect
-   both lexers to generate NAME tokens instead of NAMES (with otherwise minor
-   changes to FORMAT parsing), but the third, error reporting, would suffer,
-   and when one makes mistakes in a FORMAT, believe me, one wants a pointer
-   to exactly where the compilers thinks the problem is, to even begin to get
-   a handle on it.  So there.  */
-
-void
-ffelex_set_names_pure (bool f)
-{
-  ffelex_names_pure_ = f;
-  ffelex_names_ = f;
-}
-
-/* ffelex_splice_tokens -- Splice off and send tokens from a NAMES
-
-   return (ffelexHandler) ffelex_splice_tokens(first_handler,master_token,
-	 start_char_index);
-
-   Returns first_handler if start_char_index chars into master_token (which
-   must be a NAMES token) is '\0'. Else, creates a subtoken from that
-   char, either NUMBER (if it is a digit), a NAME (if a valid firstnamechar),
-   an UNDERSCORE (if an underscore), or DOLLAR (if a dollar sign)
-   and sends it to first_handler. If anything other than NAME is sent, the
-   character at the end of it in the master token is examined to see if it
-   begins a NAME, NUMBER, UNDERSCORE, or DOLLAR, and, if so,
-   the handler returned by first_handler is invoked with that token, and
-   this process is repeated until the end of the master token or a NAME
-   token is reached.  */
-
-ffelexHandler
-ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
-		      ffeTokenLength start)
-{
-  unsigned char *p;
-  ffeTokenLength i;
-  ffelexToken t;
-
-  p = ffelex_token_text (master) + (i = start);
-
-  while (*p != '\0')
-    {
-      if (ISDIGIT (*p))
-	{
-	  t = ffelex_token_number_from_names (master, i);
-	  p += ffelex_token_length (t);
-	  i += ffelex_token_length (t);
-	}
-      else if (ffesrc_is_name_init (*p))
-	{
-	  t = ffelex_token_name_from_names (master, i, 0);
-	  p += ffelex_token_length (t);
-	  i += ffelex_token_length (t);
-	}
-      else if (*p == '$')
-	{
-	  t = ffelex_token_dollar_from_names (master, i);
-	  ++p;
-	  ++i;
-	}
-      else if (*p == '_')
-	{
-	  t = ffelex_token_uscore_from_names (master, i);
-	  ++p;
-	  ++i;
-	}
-      else
-	{
-	  assert ("not a valid NAMES character" == NULL);
-	  t = NULL;
-	}
-      assert (first != NULL);
-      first = (ffelexHandler) (*first) (t);
-      ffelex_token_kill (t);
-    }
-
-  return first;
-}
-
-/* ffelex_swallow_tokens -- Eat all tokens delivered to me
-
-   return ffelex_swallow_tokens;
-
-   Return this handler when you don't want to look at any more tokens in the
-   statement because you've encountered an unrecoverable error in the
-   statement.  */
-
-ffelexHandler
-ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler)
-{
-  assert (handler != NULL);
-
-  if ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeEOS)
-		      || (ffelex_token_type (t) == FFELEX_typeSEMICOLON)))
-    return (ffelexHandler) (*handler) (t);
-
-  ffelex_eos_handler_ = handler;
-  return (ffelexHandler) ffelex_swallow_tokens_;
-}
-
-/* ffelex_token_dollar_from_names -- Return a dollar from within a names token
-
-   ffelexToken t;
-   t = ffelex_token_dollar_from_names(t,6);
-
-   It's as if you made a new token of dollar type having the dollar
-   at, in the example above, the sixth character of the NAMES token.  */
-
-ffelexToken
-ffelex_token_dollar_from_names (ffelexToken t, ffeTokenLength start)
-{
-  ffelexToken nt;
-
-  assert (t != NULL);
-  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
-  assert (start < t->length);
-  assert (t->text[start] == '$');
-
-  /* Now make the token. */
-
-  nt = ffelex_token_new_ ();
-  nt->type = FFELEX_typeDOLLAR;
-  nt->length = 0;
-  nt->uses = 1;
-  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
-			   t->where_col, t->wheretrack, start);
-  nt->text = NULL;
-  return nt;
-}
-
-/* ffelex_token_kill -- Decrement use count for token, kill if no uses left
-
-   ffelexToken t;
-   ffelex_token_kill(t);
-
-   Complements a call to ffelex_token_use or ffelex_token_new_....  */
-
-void
-ffelex_token_kill (ffelexToken t)
-{
-  assert (t != NULL);
-
-  assert (t->uses > 0);
-
-  if (--t->uses != 0)
-    return;
-
-  --ffelex_total_tokens_;
-
-  if (t->type == FFELEX_typeNAMES)
-    ffewhere_track_kill (t->where_line, t->where_col,
-			 t->wheretrack, t->length);
-  ffewhere_line_kill (t->where_line);
-  ffewhere_column_kill (t->where_col);
-  if (t->text != NULL)
-    malloc_kill_ksr (malloc_pool_image (), t->text, t->size + 1);
-  malloc_kill_ks (malloc_pool_image (), t, sizeof (*t));
-}
-
-/* Make a new NAME token that is a substring of a NAMES token.  */
-
-ffelexToken
-ffelex_token_name_from_names (ffelexToken t, ffeTokenLength start,
-			      ffeTokenLength len)
-{
-  ffelexToken nt;
-
-  assert (t != NULL);
-  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
-  assert (start < t->length);
-  if (len == 0)
-    len = t->length - start;
-  else
-    {
-      assert (len > 0);
-      assert ((start + len) <= t->length);
-    }
-  assert (ffelex_is_firstnamechar ((unsigned char)(t->text[start])));
-
-  nt = ffelex_token_new_ ();
-  nt->type = FFELEX_typeNAME;
-  nt->size = len;		/* Assume nobody's gonna fiddle with token
-				   text. */
-  nt->length = len;
-  nt->uses = 1;
-  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
-			   t->where_col, t->wheretrack, start);
-  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			     len + 1);
-  strncpy (nt->text, t->text + start, len);
-  nt->text[len] = '\0';
-  return nt;
-}
-
-/* Make a new NAMES token that is a substring of another NAMES token.  */
-
-ffelexToken
-ffelex_token_names_from_names (ffelexToken t, ffeTokenLength start,
-			       ffeTokenLength len)
-{
-  ffelexToken nt;
-
-  assert (t != NULL);
-  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
-  assert (start < t->length);
-  if (len == 0)
-    len = t->length - start;
-  else
-    {
-      assert (len > 0);
-      assert ((start + len) <= t->length);
-    }
-  assert (ffelex_is_firstnamechar ((unsigned char)(t->text[start])));
-
-  nt = ffelex_token_new_ ();
-  nt->type = FFELEX_typeNAMES;
-  nt->size = len;		/* Assume nobody's gonna fiddle with token
-				   text. */
-  nt->length = len;
-  nt->uses = 1;
-  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
-			   t->where_col, t->wheretrack, start);
-  ffewhere_track_copy (nt->wheretrack, t->wheretrack, start, len);
-  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			     len + 1);
-  strncpy (nt->text, t->text + start, len);
-  nt->text[len] = '\0';
-  return nt;
-}
-
-/* Make a new CHARACTER token.  */
-
-ffelexToken
-ffelex_token_new_character (const char *s, ffewhereLine l, ffewhereColumn c)
-{
-  ffelexToken t;
-
-  t = ffelex_token_new_ ();
-  t->type = FFELEX_typeCHARACTER;
-  t->length = t->size = strlen (s);	/* Assume it won't get bigger. */
-  t->uses = 1;
-  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			    t->size + 1);
-  strcpy (t->text, s);
-  t->where_line = ffewhere_line_use (l);
-  t->where_col = ffewhere_column_new (c);
-  return t;
-}
-
-/* Make a new EOF token right after end of file.  */
-
-ffelexToken
-ffelex_token_new_eof (void)
-{
-  ffelexToken t;
-
-  t = ffelex_token_new_ ();
-  t->type = FFELEX_typeEOF;
-  t->uses = 1;
-  t->text = NULL;
-  t->where_line = ffewhere_line_new (ffelex_linecount_current_);
-  t->where_col = ffewhere_column_new (1);
-  return t;
-}
-
-/* Make a new NAME token.  */
-
-ffelexToken
-ffelex_token_new_name (const char *s, ffewhereLine l, ffewhereColumn c)
-{
-  ffelexToken t;
-
-  assert (ffelex_is_firstnamechar ((unsigned char)*s));
-
-  t = ffelex_token_new_ ();
-  t->type = FFELEX_typeNAME;
-  t->length = t->size = strlen (s);	/* Assume it won't get bigger. */
-  t->uses = 1;
-  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			    t->size + 1);
-  strcpy (t->text, s);
-  t->where_line = ffewhere_line_use (l);
-  t->where_col = ffewhere_column_new (c);
-  return t;
-}
-
-/* Make a new NAMES token.  */
-
-ffelexToken
-ffelex_token_new_names (const char *s, ffewhereLine l, ffewhereColumn c)
-{
-  ffelexToken t;
-
-  assert (ffelex_is_firstnamechar ((unsigned char)*s));
-
-  t = ffelex_token_new_ ();
-  t->type = FFELEX_typeNAMES;
-  t->length = t->size = strlen (s);	/* Assume it won't get bigger. */
-  t->uses = 1;
-  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			    t->size + 1);
-  strcpy (t->text, s);
-  t->where_line = ffewhere_line_use (l);
-  t->where_col = ffewhere_column_new (c);
-  ffewhere_track_clear (t->wheretrack, t->length);	/* Assume contiguous
-							   names. */
-  return t;
-}
-
-/* Make a new NUMBER token.
-
-   The first character of the string must be a digit, and only the digits
-   are copied into the new number.  So this may be used to easily extract
-   a NUMBER token from within any text string.  Then the length of the
-   resulting token may be used to calculate where the digits stopped
-   in the original string.  */
-
-ffelexToken
-ffelex_token_new_number (const char *s, ffewhereLine l, ffewhereColumn c)
-{
-  ffelexToken t;
-  ffeTokenLength len;
-
-  /* How long is the string of decimal digits at s? */
-
-  len = strspn (s, "0123456789");
-
-  /* Make sure there is at least one digit. */
-
-  assert (len != 0);
-
-  /* Now make the token. */
-
-  t = ffelex_token_new_ ();
-  t->type = FFELEX_typeNUMBER;
-  t->length = t->size = len;	/* Assume it won't get bigger. */
-  t->uses = 1;
-  t->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			    len + 1);
-  strncpy (t->text, s, len);
-  t->text[len] = '\0';
-  t->where_line = ffewhere_line_use (l);
-  t->where_col = ffewhere_column_new (c);
-  return t;
-}
-
-/* Make a new token of any type that doesn't contain text.  A private
-   function that is used by public macros in the interface file.  */
-
-ffelexToken
-ffelex_token_new_simple_ (ffelexType type, ffewhereLine l, ffewhereColumn c)
-{
-  ffelexToken t;
-
-  t = ffelex_token_new_ ();
-  t->type = type;
-  t->uses = 1;
-  t->text = NULL;
-  t->where_line = ffewhere_line_use (l);
-  t->where_col = ffewhere_column_new (c);
-  return t;
-}
-
-/* Make a new NUMBER token from an existing NAMES token.
-
-   Like ffelex_token_new_number, this function calculates the length
-   of the digit string itself.  */
-
-ffelexToken
-ffelex_token_number_from_names (ffelexToken t, ffeTokenLength start)
-{
-  ffelexToken nt;
-  ffeTokenLength len;
-
-  assert (t != NULL);
-  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
-  assert (start < t->length);
-
-  /* How long is the string of decimal digits at s? */
-
-  len = strspn (t->text + start, "0123456789");
-
-  /* Make sure there is at least one digit. */
-
-  assert (len != 0);
-
-  /* Now make the token. */
-
-  nt = ffelex_token_new_ ();
-  nt->type = FFELEX_typeNUMBER;
-  nt->size = len;		/* Assume nobody's gonna fiddle with token
-				   text. */
-  nt->length = len;
-  nt->uses = 1;
-  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
-			   t->where_col, t->wheretrack, start);
-  nt->text = malloc_new_ksr (malloc_pool_image (), "FFELEX token text",
-			     len + 1);
-  strncpy (nt->text, t->text + start, len);
-  nt->text[len] = '\0';
-  return nt;
-}
-
-/* Make a new UNDERSCORE token from a NAMES token.  */
-
-ffelexToken
-ffelex_token_uscore_from_names (ffelexToken t, ffeTokenLength start)
-{
-  ffelexToken nt;
-
-  assert (t != NULL);
-  assert (ffelex_token_type (t) == FFELEX_typeNAMES);
-  assert (start < t->length);
-  assert (t->text[start] == '_');
-
-  /* Now make the token. */
-
-  nt = ffelex_token_new_ ();
-  nt->type = FFELEX_typeUNDERSCORE;
-  nt->uses = 1;
-  ffewhere_set_from_track (&nt->where_line, &nt->where_col, t->where_line,
-			   t->where_col, t->wheretrack, start);
-  nt->text = NULL;
-  return nt;
-}
-
-/* ffelex_token_use -- Return another instance of a token
-
-   ffelexToken t;
-   t = ffelex_token_use(t);
-
-   In a sense, the new token is a copy of the old, though it might be the
-   same with just a new use count.
-
-   We use the use count method (easy).	*/
-
-ffelexToken
-ffelex_token_use (ffelexToken t)
-{
-  if (t == NULL)
-    assert ("_token_use: null token" == NULL);
-  t->uses++;
-  return t;
-}
-
-#include "gt-f-lex.h"
diff --git a/gcc/f/lex.h b/gcc/f/lex.h
deleted file mode 100644
index 04dfbed..0000000
--- a/gcc/f/lex.h
+++ /dev/null
@@ -1,200 +0,0 @@
-/* lex.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      lex.c
-
-   Modifications:
-      22-Aug-89	 JCB  1.1
-	 Change for new ffewhere interface.
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_LEX_H
-#define GCC_F_LEX_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFELEX_typeNONE,
-    FFELEX_typeCOMMENT,
-    FFELEX_typeEOS,
-    FFELEX_typeEOF,
-    FFELEX_typeERROR,
-    FFELEX_typeRAW,
-    FFELEX_typeQUOTE,
-    FFELEX_typeDOLLAR,
-    FFELEX_typeHASH,
-    FFELEX_typePERCENT,
-    FFELEX_typeAMPERSAND,
-    FFELEX_typeAPOSTROPHE,
-    FFELEX_typeOPEN_PAREN,
-    FFELEX_typeCLOSE_PAREN,
-    FFELEX_typeASTERISK,
-    FFELEX_typePLUS,
-    FFELEX_typeMINUS,
-    FFELEX_typePERIOD,
-    FFELEX_typeSLASH,
-    FFELEX_typeNUMBER,		/* Grep: [0-9][0-9]*. */
-    FFELEX_typeOPEN_ANGLE,
-    FFELEX_typeEQUALS,
-    FFELEX_typeCLOSE_ANGLE,
-    FFELEX_typeNAME,		/* Grep: [A-Za-z][A-Za-z0-9_]*. */
-    FFELEX_typeCOMMA,
-    FFELEX_typePOWER,		/* "**". */
-    FFELEX_typeCONCAT,		/* "//". */
-    FFELEX_typeDEBUG,
-    FFELEX_typeNAMES,		/* Same as FFELEX_typeNAME in initial
-				   context. */
-    FFELEX_typeHOLLERITH,	/* <text> part of <nn>H<text>. */
-    FFELEX_typeCHARACTER,	/* <text> part of '<text>' or "<text>". */
-    FFELEX_typeCOLON,
-    FFELEX_typeSEMICOLON,
-    FFELEX_typeUNDERSCORE,
-    FFELEX_typeQUESTION,
-    FFELEX_typeOPEN_ARRAY,	/* "(/". */
-    FFELEX_typeCLOSE_ARRAY,	/* "/)". */
-    FFELEX_typeCOLONCOLON,	/* "::". */
-    FFELEX_typeREL_LE,		/* "<=". */
-    FFELEX_typeREL_NE,		/* "<>". */
-    FFELEX_typeREL_EQ,		/* "==". */
-    FFELEX_typePOINTS,		/* "=>". */
-    FFELEX_typeREL_GE,		/* ">=". */
-    FFELEX_type
-  } ffelexType;
-
-/* Typedefs. */
-
-typedef struct _lextoken_ *ffelexToken;
-typedef void *lex_sigh_;
-typedef lex_sigh_ (*lex_sigh__) (ffelexToken);
-typedef lex_sigh__ (*ffelexHandler) (ffelexToken);
-
-/* Include files needed by this one. */
-
-#include "top.h"
-#include "where.h"
-
-/* Structure definitions. */
-
-struct _lextoken_
-  {
-    long int id_;		/* DEBUG ONLY. */
-    ffeTokenLength size;
-    ffeTokenLength length;
-    unsigned short uses;
-    char *text;
-    ffelexType type;
-    ffewhereLine where_line;
-    ffewhereColumn where_col;
-    ffewhereLine currentnames_line;	/* For tracking NAMES tokens. */
-    ffewhereColumn currentnames_col;	/* For tracking NAMES tokens. */
-    ffewhereTrack wheretrack;	/* For tracking NAMES tokens. */
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffelex_display_token (ffelexToken t);
-bool ffelex_expecting_character (void);
-ffelexHandler ffelex_file_fixed (ffewhereFile wf, FILE *f);
-ffelexHandler ffelex_file_free (ffewhereFile wf, FILE *f);
-void ffelex_hash_kludge (FILE *f);
-void ffelex_init_1 (void);
-bool ffelex_is_names_expected (void);
-char *ffelex_line (void);
-ffewhereColumnNumber ffelex_line_length (void);
-ffewhereLineNumber ffelex_line_number (void);
-void ffelex_set_expecting_hollerith (long length, char which,
-				     ffewhereLine line,
-				     ffewhereColumn column);
-void ffelex_set_handler (ffelexHandler first);
-void ffelex_set_hexnum (bool on);
-void ffelex_set_include (ffewhereFile wf, bool free_form, FILE *fi);
-void ffelex_set_names (bool on);
-void ffelex_set_names_pure (bool on);
-ffelexHandler ffelex_splice_tokens (ffelexHandler first, ffelexToken master,
-				    ffeTokenLength start);
-ffelexHandler ffelex_swallow_tokens (ffelexToken t, ffelexHandler handler);
-ffelexToken ffelex_token_dollar_from_names (ffelexToken t,
-					    ffeTokenLength start);
-void ffelex_token_kill (ffelexToken t);
-ffelexToken ffelex_token_name_from_names (ffelexToken t,
-					  ffeTokenLength start,
-					  ffeTokenLength len);
-ffelexToken ffelex_token_names_from_names (ffelexToken t,
-					   ffeTokenLength start,
-					   ffeTokenLength len);
-ffelexToken ffelex_token_new (void);
-ffelexToken ffelex_token_new_character (const char *s, ffewhereLine l,
-					ffewhereColumn c);
-ffelexToken ffelex_token_new_eof (void);
-ffelexToken ffelex_token_new_name (const char *s, ffewhereLine l,
-				   ffewhereColumn c);
-ffelexToken ffelex_token_new_names (const char *s, ffewhereLine l,
-				    ffewhereColumn c);
-ffelexToken ffelex_token_new_number (const char *s, ffewhereLine l,
-				     ffewhereColumn c);
-ffelexToken ffelex_token_new_simple_ (ffelexType type, ffewhereLine l,
-				      ffewhereColumn c);
-ffelexToken ffelex_token_number_from_names (ffelexToken t,
-					    ffeTokenLength start);
-ffelexToken ffelex_token_uscore_from_names (ffelexToken t,
-					    ffeTokenLength start);
-ffelexToken ffelex_token_use (ffelexToken t);
-
-/* Define macros. */
-
-#define ffelex_init_0()
-#define ffelex_init_2()
-#define ffelex_init_3()
-#define ffelex_init_4()
-#define ffelex_is_firstnamechar(c) ISIDST (c)
-#define ffelex_terminate_0()
-#define ffelex_terminate_1()
-#define ffelex_terminate_2()
-#define ffelex_terminate_3()
-#define ffelex_terminate_4()
-#define ffelex_token_length(t) ((t)->length)
-#define ffelex_token_new_eos(l,c) \
-  ffelex_token_new_simple_ (FFELEX_typeEOS, (l), (c))
-#define ffelex_token_new_period(l,c) \
-  ffelex_token_new_simple_ (FFELEX_typePERIOD, (l), (c))
-#define ffelex_token_strcmp(t1,t2) strcmp ((t1)->text, (t2)->text)
-#define ffelex_token_text(t) ((t)->text)
-#define ffelex_token_type(t) ((t)->type)
-#define ffelex_token_where_column(t) ((t)->where_col)
-#define ffelex_token_where_filename(t) \
-  ffewhere_line_filename ((t)->where_line)
-#define ffelex_token_where_filelinenum(t) \
-  ffewhere_line_filelinenum((t)->where_line)
-#define ffelex_token_where_line(t) ((t)->where_line)
-#define ffelex_token_where_line_number(t) \
-  ffewhere_line_number ((t)->where_line)
-#define ffelex_token_wheretrack(t) ((t)->wheretrack)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_LEX_H */
diff --git a/gcc/f/malloc.c b/gcc/f/malloc.c
deleted file mode 100644
index 7a84781..0000000
--- a/gcc/f/malloc.c
+++ /dev/null
@@ -1,551 +0,0 @@
-/* malloc.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Fast pool-based memory allocation.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "malloc.h"
-
-/* Externals defined here.  */
-
-struct _malloc_root_ malloc_root_
-=
-{
-  {
-    &malloc_root_.malloc_pool_image_,
-    &malloc_root_.malloc_pool_image_,
-    (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
-    (mallocPool) &malloc_root_.malloc_pool_image_.eldest,
-    (mallocArea_) &malloc_root_.malloc_pool_image_.first,
-    (mallocArea_) &malloc_root_.malloc_pool_image_.first,
-    0,
-#if MALLOC_DEBUG
-    0, 0, 0, 0, 0, 0, 0, { '/' }
-#else
-    { 0 }
-#endif
-  },
-};
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-static void *malloc_reserve_ = NULL;	/* For crashes. */
-#if MALLOC_DEBUG
-static const char *const malloc_types_[] =
-{"KS", "KSR", "NF", "NFR", "US", "USR"};
-#endif
-
-/* Static functions (internal). */
-
-static void malloc_kill_area_ (mallocPool pool, mallocArea_ a);
-#if MALLOC_DEBUG
-static void malloc_verify_area_ (mallocPool pool, mallocArea_ a);
-#endif
-
-/* Internal macros. */
-
-#if MALLOC_DEBUG
-#define malloc_kill_(ptr,s) do {memset((ptr),127,(s));free((ptr));} while(0)
-#else
-#define malloc_kill_(ptr,s) free((ptr))
-#endif
-
-/* malloc_kill_area_ -- Kill storage area and its object
-
-   malloc_kill_area_(mallocPool pool,mallocArea_ area);
-
-   Does the actual killing of a storage area.  */
-
-static void
-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);
-  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);
-}
-
-/* malloc_verify_area_ -- Verify storage area and its object
-
-   malloc_verify_area_(mallocPool pool,mallocArea_ area);
-
-   Does the actual verifying of a storage area.  */
-
-#if MALLOC_DEBUG
-static void
-malloc_verify_area_ (mallocPool pool UNUSED, mallocArea_ a UNUSED)
-{
-  mallocSize s = a->size;
-
-  assert (strcmp (a->name, ((char *) (a->where)) + s) == 0);
-}
-#endif
-
-/* malloc_init -- Initialize malloc cluster
-
-   malloc_init();
-
-   Call malloc_init before you do anything else.  */
-
-void
-malloc_init (void)
-{
-  if (malloc_reserve_ != NULL)
-    return;
-  malloc_reserve_ = xmalloc (20 * 1024); /* In case of crash, free this first. */
-}
-
-/* malloc_pool_display -- Display a pool
-
-   mallocPool p;
-   malloc_pool_display(p);
-
-   Displays information associated with the pool and its subpools.  */
-
-void
-malloc_pool_display (mallocPool p UNUSED)
-{
-#if MALLOC_DEBUG
-  mallocPool q;
-  mallocArea_ a;
-
-  fprintf (dmpout, "Pool \"%s\": bytes allocated=%lu, freed=%lu, old sizes=%lu, new sizes\
-=%lu,\n   allocations=%lu, frees=%lu, resizes=%lu, uses=%lu\n   Subpools:\n",
-	   p->name, p->allocated, p->freed, p->old_sizes, p->new_sizes, p->allocations,
-	   p->frees, p->resizes, p->uses);
-
-  for (q = p->eldest; q != (mallocPool) & p->eldest; q = q->next)
-    fprintf (dmpout, "      \"%s\"\n", q->name);
-
-  fprintf (dmpout, "   Storage areas:\n");
-
-  for (a = p->first; a != (mallocArea_) & p->first; a = a->next)
-    {
-      fprintf (dmpout, "      ");
-      malloc_display_ (a);
-    }
-#endif
-}
-
-/* malloc_pool_kill -- Destroy a pool
-
-   mallocPool p;
-   malloc_pool_kill(p);
-
-   Releases all storage associated with the pool and its subpools.  */
-
-void
-malloc_pool_kill (mallocPool p)
-{
-  mallocPool q;
-  mallocArea_ a;
-
-  if (--p->uses != 0)
-    return;
-
-#if 0
-  malloc_pool_display (p);
-#endif
-
-  assert (p->next->previous == p);
-  assert (p->previous->next == p);
-
-  /* Kill off all the subpools. */
-
-  while ((q = p->eldest) != (mallocPool) &p->eldest)
-    {
-      q->uses = 1;		/* Force the kill. */
-      malloc_pool_kill (q);
-    }
-
-  /* Now free all the storage areas. */
-
-  while ((a = p->first) != (mallocArea_) & p->first)
-    {
-      malloc_kill_area_ (p, a);
-    }
-
-  /* Now remove from list of sibling pools. */
-
-  p->next->previous = p->previous;
-  p->previous->next = p->next;
-
-  /* Finally, free the pool itself. */
-
-  malloc_kill_ (p,
-		offsetof (struct _malloc_pool_, name)
-		+ strlen (p->name) + 1);
-}
-
-/* malloc_pool_new -- Make a new pool
-
-   mallocPool p;
-   p = malloc_pool_new("My new pool",malloc_pool_image(),1024);
-
-   Makes a new pool with the given name and default new-chunk allocation.  */
-
-mallocPool
-malloc_pool_new (const char *name, mallocPool parent,
-		 unsigned long chunks UNUSED)
-{
-  mallocPool p;
-
-  if (parent == NULL)
-    parent = malloc_pool_image ();
-
-  p = malloc_new_ (offsetof (struct _malloc_pool_, name)
-		   + (MALLOC_DEBUG ? strlen (name) + 1 : 0));
-  p->next = (mallocPool) &(parent->eldest);
-  p->previous = parent->youngest;
-  parent->youngest->next = p;
-  parent->youngest = p;
-  p->eldest = (mallocPool) &(p->eldest);
-  p->youngest = (mallocPool) &(p->eldest);
-  p->first = (mallocArea_) &(p->first);
-  p->last = (mallocArea_) &(p->first);
-  p->uses = 1;
-#if MALLOC_DEBUG
-  p->allocated = p->freed = p->old_sizes = p->new_sizes = p->allocations
-    = p->frees = p->resizes = 0;
-  strcpy (p->name, name);
-#endif
-  return p;
-}
-
-/* malloc_pool_use -- Use an existing pool
-
-   mallocPool p;
-   p = malloc_pool_new(pool);
-
-   Increments use count for pool; means a matching malloc_pool_kill must
-   be performed before a subsequent one will actually kill the pool.  */
-
-mallocPool
-malloc_pool_use (mallocPool pool)
-{
-  ++pool->uses;
-  return pool;
-}
-
-/* malloc_display_ -- Display info on a mallocArea_
-
-   mallocArea_ a;
-   malloc_display_(a);
-
-   Simple.  */
-
-void
-malloc_display_ (mallocArea_ a UNUSED)
-{
-#if MALLOC_DEBUG
-  fprintf (dmpout, "At %08lX, size=%" mallocSize_f "u, type=%s, \"%s\"\n",
-	(unsigned long) a->where, a->size, malloc_types_[a->type], a->name);
-#endif
-}
-
-/* malloc_find_inpool_ -- Find mallocArea_ for object in pool
-
-   mallocPool pool;
-   void *ptr;
-   mallocArea_ a;
-   a = malloc_find_inpool_(pool,ptr);
-
-   Search for object in list of mallocArea_s, die if not found.	 */
-
-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;
-}
-
-/* malloc_kill_inpool_ -- Kill object
-
-   malloc_kill_inpool_(NULL,MALLOC_typeUS_,ptr,size_in_bytes);
-
-   Find the mallocArea_ for the pointer, make sure the type is proper, and
-   kill both of them.  */
-
-void
-malloc_kill_inpool_ (mallocPool pool, mallocType_ type UNUSED,
-		     void *ptr, mallocSize s UNUSED)
-{
-  mallocArea_ a;
-
-  if (pool == NULL)
-    pool = malloc_pool_image ();
-
-#if MALLOC_DEBUG
-  assert ((pool == malloc_pool_image ())
-	  || malloc_pool_find_ (pool, malloc_pool_image ()));
-#endif
-
-  a = malloc_find_inpool_ (pool, ptr);
-#if MALLOC_DEBUG
-  assert (a->type == type);
-  if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
-    assert (a->size == s);
-#endif
-  malloc_kill_area_ (pool, a);
-}
-
-/* malloc_new_ -- Allocate new object, die if unable
-
-   ptr = malloc_new_(size_in_bytes);
-
-   Call malloc, bomb if it returns NULL.  */
-
-void *
-malloc_new_ (mallocSize s)
-{
-  void *ptr;
-  unsigned ss = s;
-
-#if MALLOC_DEBUG && 0
-  assert (s == (mallocSize) ss);/* Else alloc is too big for this
-				   library/sys. */
-#endif
-
-  ptr = xmalloc (ss);
-#if MALLOC_DEBUG
-  memset (ptr, 126, ss);	/* Catch some kinds of errors more
-				   quickly/reliably. */
-#endif
-  return ptr;
-}
-
-/* malloc_new_inpool_ -- Allocate new object, die if unable
-
-   ptr = malloc_new_inpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes);
-
-   Allocate the structure and allocate a mallocArea_ to describe it, then
-   add it to the list of mallocArea_s for the pool.  */
-
-void *
-malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s)
-{
-  void *ptr;
-  mallocArea_ a;
-  unsigned short i;
-
-  if (pool == NULL)
-    pool = malloc_pool_image ();
-
-#if MALLOC_DEBUG
-  assert ((pool == malloc_pool_image ())
-	  || malloc_pool_find_ (pool, malloc_pool_image ()));
-#endif
-
-  ptr = malloc_new_ (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);
-  switch (type)
-    {				/* A little optimization to speed up killing
-				   of non-permanent stuff. */
-    case MALLOC_typeKP_:
-    case MALLOC_typeKPR_:
-      a->next = (mallocArea_) &pool->first;
-      break;
-
-    default:
-      a->next = pool->first;
-      break;
-    }
-  a->previous = a->next->previous;
-  a->next->previous = a;
-  a->previous->next = a;
-  a->where = ptr;
-#if MALLOC_DEBUG
-  a->size = s;
-  a->type = type;
-  strcpy (a->name, name);
-  pool->allocated += s;
-  pool->allocations++;
-#endif
-  return ptr;
-}
-
-/* malloc_new_zinpool_ -- Allocate new zeroed object, die if unable
-
-   ptr = malloc_new_zinpool_(NULL,MALLOC_typeUS_,"object",size_in_bytes,0);
-
-   Like malloc_new_inpool_, but zeros out all the bytes in the area (assuming
-   you pass it a 0).  */
-
-void *
-malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name, mallocSize s,
-		     int z)
-{
-  void *ptr;
-
-  ptr = malloc_new_inpool_ (pool, type, name, s);
-  memset (ptr, z, s);
-  return ptr;
-}
-
-/* malloc_pool_find_ -- See if pool is a descendant of another pool
-
-   if (malloc_pool_find_(target_pool,parent_pool)) ...;
-
-   Recursive descent on each of the children of the parent pool, after
-   first checking the children themselves.  */
-
-char
-malloc_pool_find_ (mallocPool pool, mallocPool parent)
-{
-  mallocPool p;
-
-  for (p = parent->eldest; p != (mallocPool) & parent->eldest; p = p->next)
-    {
-      if ((p == pool) || malloc_pool_find_ (pool, p))
-	return 1;
-    }
-  return 0;
-}
-
-/* malloc_resize_inpool_ -- Resize existing object in pool
-
-   ptr = malloc_resize_inpool_(NULL,MALLOC_typeUSR_,ptr,new_size,old_size);
-
-   Find the object's mallocArea_, check it out, then do the resizing.  */
-
-void *
-malloc_resize_inpool_ (mallocPool pool, mallocType_ type UNUSED,
-		       void *ptr, mallocSize ns, mallocSize os UNUSED)
-{
-  mallocArea_ a;
-
-  if (pool == NULL)
-    pool = malloc_pool_image ();
-
-#if MALLOC_DEBUG
-  assert ((pool == malloc_pool_image ())
-	  || malloc_pool_find_ (pool, malloc_pool_image ()));
-#endif
-
-  a = malloc_find_inpool_ (pool, ptr);
-#if MALLOC_DEBUG
-  assert (a->type == type);
-  if ((type == MALLOC_typeKSR_) || (type == MALLOC_typeKPR_))
-    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));
-  a->where = ptr;
-#if MALLOC_DEBUG
-  a->size = ns;
-  strcpy (((char *) (ptr)) + ns, a->name);
-  pool->old_sizes += os;
-  pool->new_sizes += ns;
-  pool->resizes++;
-#endif
-  return ptr;
-}
-
-/* malloc_resize_ -- Reallocate object, die if unable
-
-   ptr = malloc_resize_(ptr,size_in_bytes);
-
-   Call realloc, bomb if it returns NULL.  */
-
-void *
-malloc_resize_ (void *ptr, mallocSize s)
-{
-  int ss = s;
-
-#if MALLOC_DEBUG && 0
-  assert (s == (mallocSize) ss);/* Too big if failure here. */
-#endif
-
-  ptr = xrealloc (ptr, ss);
-  return ptr;
-}
-
-/* malloc_verify_inpool_ -- Verify object
-
-   Find the mallocArea_ for the pointer, make sure the type is proper, and
-   verify both of them.  */
-
-void
-malloc_verify_inpool_ (mallocPool pool UNUSED, mallocType_ type UNUSED,
-		       void *ptr UNUSED, mallocSize s UNUSED)
-{
-#if MALLOC_DEBUG
-  mallocArea_ a;
-
-  if (pool == NULL)
-    pool = malloc_pool_image ();
-
-  assert ((pool == malloc_pool_image ())
-	  || malloc_pool_find_ (pool, malloc_pool_image ()));
-
-  a = malloc_find_inpool_ (pool, ptr);
-  assert (a->type == type);
-  if ((type != MALLOC_typeUS_) && (type != MALLOC_typeUSR_))
-    assert (a->size == s);
-  malloc_verify_area_ (pool, a);
-#endif
-}
diff --git a/gcc/f/malloc.h b/gcc/f/malloc.h
deleted file mode 100644
index 1c82720..0000000
--- a/gcc/f/malloc.h
+++ /dev/null
@@ -1,183 +0,0 @@
-/* malloc.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      malloc.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_MALLOC_H
-#define GCC_F_MALLOC_H
-
-#ifndef MALLOC_DEBUG
-#define MALLOC_DEBUG 0	/* 1 means check caller's use of this module. */
-#endif
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    MALLOC_typeKS_,
-    MALLOC_typeKSR_,
-    MALLOC_typeKP_,
-    MALLOC_typeKPR_,
-    MALLOC_typeUS_,
-    MALLOC_typeUSR_,
-    MALLOC_type_
-  } mallocType_;
-
-/* Typedefs. */
-
-typedef struct _malloc_area_ *mallocArea_;
-typedef struct _malloc_pool_ *mallocPool;
-typedef unsigned long int mallocSize;
-#define mallocSize_f "l"
-
-/* Include files needed by this one. */
-
-
-/* Structure definitions. */
-
-struct _malloc_area_
-  {
-    mallocArea_ next;
-    mallocArea_ previous;
-    void *where;
-#if MALLOC_DEBUG
-    mallocSize size;
-    mallocType_ type;
-#endif
-    char name[1];
-  };
-
-struct _malloc_pool_
-  {
-    mallocPool next;
-    mallocPool previous;
-    mallocPool eldest;
-    mallocPool youngest;
-    mallocArea_ first;
-    mallocArea_ last;
-    unsigned long uses;
-#if MALLOC_DEBUG
-    mallocSize allocated;
-    mallocSize freed;
-    mallocSize old_sizes;
-    mallocSize new_sizes;
-    unsigned long allocations;
-    unsigned long frees;
-    unsigned long resizes;
-#endif
-    char name[1];
-  };
-
-struct _malloc_root_
-  {
-    struct _malloc_pool_ malloc_pool_image_;
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern struct _malloc_root_ malloc_root_;
-
-/* Declare functions with prototypes. */
-
-void malloc_display_ (mallocArea_ a);
-mallocArea_ malloc_find_inpool_ (mallocPool pool, void *ptr);
-void malloc_init (void);
-void malloc_kill_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
-			  mallocSize size);
-void *malloc_new_ (mallocSize size);
-void *malloc_new_inpool_ (mallocPool pool, mallocType_ type, const char *name,
-			  mallocSize size);
-void *malloc_new_zinpool_ (mallocPool pool, mallocType_ type, const char *name,
-			   mallocSize size, int z);
-void malloc_pool_display (mallocPool p);
-char malloc_pool_find_ (mallocPool p, mallocPool parent);
-void malloc_pool_kill (mallocPool p);
-mallocPool malloc_pool_new (const char *name, mallocPool parent, unsigned long chunks);
-mallocPool malloc_pool_use (mallocPool p);
-void *malloc_resize_ (void *ptr, mallocSize new_size);
-void *malloc_resize_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
-			     mallocSize new_size, mallocSize old_size);
-void malloc_verify_inpool_ (mallocPool pool, mallocType_ type, void *ptr,
-			    mallocSize size);
-
-/* Define macros. */
-
-#define malloc_new_ks(pool,name,size) \
-  malloc_new_inpool_ (pool,MALLOC_typeKS_,name,size)
-#define malloc_new_ksr(pool,name,size) \
-  malloc_new_inpool_ (pool,MALLOC_typeKSR_,name,size)
-#define malloc_new_kp(pool,name,size) \
-  malloc_new_inpool_ (pool,MALLOC_typeKP_,name,size)
-#define malloc_new_kpr(pool,name,size) \
-  malloc_new_inpool_ (pool,MALLOC_typeKPR_,name,size)
-#define malloc_new_us(pool,name,size) \
-  malloc_new_inpool_ (pool,MALLOC_typeUS_,name,size)
-#define malloc_new_usr(pool,name,size) \
-  malloc_new_inpool_ (pool,MALLOC_typeUSR_,name,size)
-#define malloc_new_zks(pool,name,size,z) \
-  malloc_new_zinpool_ (pool,MALLOC_typeKS_,name,size,z)
-#define malloc_new_zksr(pool,name,size,z) \
-  malloc_new_zinpool_ (pool,MALLOC_typeKSR_,name,size,z)
-#define malloc_new_zkp(pool,name,size,z) \
-  malloc_new_zinpool_ (pool,MALLOC_typeKP_,name,size,z)
-#define malloc_new_zkpr(pool,name,size,z) \
-  malloc_new_zinpool_ (pool,MALLOC_typeKPR_,name,size,z)
-#define malloc_new_zus(pool,name,size,z) \
-  malloc_new_zinpool_ (pool,MALLOC_typeUS_,name,size,z)
-#define malloc_new_zusr(pool,name,size,z) \
-  malloc_new_zinpool_ (pool,MALLOC_typeUSR_,name,size,z)
-#define malloc_kill_ks(pool,ptr,size) \
-  malloc_kill_inpool_ (pool,MALLOC_typeKS_,ptr,size)
-#define malloc_kill_ksr(pool,ptr,size) \
-  malloc_kill_inpool_ (pool,MALLOC_typeKSR_,ptr,size)
-#define malloc_kill_us(pool,ptr) \
-  malloc_kill_inpool_ (pool,MALLOC_typeUS_,ptr,0)
-#define malloc_kill_usr(pool,ptr) \
-  malloc_kill_inpool_ (pool,MALLOC_typeUSR_,ptr,0)
-#define malloc_pool_image() (&malloc_root_.malloc_pool_image_)
-#define malloc_resize_ksr(pool,ptr,new_size,old_size) \
-  malloc_resize_inpool_ (pool,MALLOC_typeKSR_,ptr,new_size,old_size)
-#define malloc_resize_kpr(pool,ptr,new_size,old_size) \
-  malloc_resize_inpool_ (pool,MALLOC_typeKPR_,ptr,new_size,old_size)
-#define malloc_resize_usr(pool,ptr,new_size) \
-  malloc_resize_inpool_ (pool,MALLOC_typeUSR_,ptr,new_size,0)
-#define malloc_verify_kp(pool,name,size) \
-  malloc_verify_inpool_ (pool,MALLOC_typeKP_,name,size)
-#define malloc_verify_kpr(pool,name,size) \
-  malloc_verify_inpool_ (pool,MALLOC_typeKPR_,name,size)
-#define malloc_verify_ks(pool,ptr,size) \
-  malloc_verify_inpool_ (pool,MALLOC_typeKS_,ptr,size)
-#define malloc_verify_ksr(pool,ptr,size) \
-  malloc_verify_inpool_ (pool,MALLOC_typeKSR_,ptr,size)
-#define malloc_verify_us(pool,ptr) \
-  malloc_verify_inpool_ (pool,MALLOC_typeUS_,ptr,0)
-#define malloc_verify_usr(pool,ptr) \
-  malloc_verify_inpool_ (pool,MALLOC_typeUSR_,ptr,0)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_MALLOC_H */
diff --git a/gcc/f/name.c b/gcc/f/name.c
deleted file mode 100644
index 26f713e..0000000
--- a/gcc/f/name.c
+++ /dev/null
@@ -1,241 +0,0 @@
-/* name.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None.
-
-   Description:
-      Name and name space abstraction.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "bad.h"
-#include "name.h"
-#include "lex.h"
-#include "malloc.h"
-#include "src.h"
-#include "where.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-static ffename ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found);
-
-/* Internal macros. */
-
-
-/* Searches for and returns the matching ffename object, or returns a
-   pointer to the name before which the new name should go.  */
-
-static ffename
-ffename_lookup_ (ffenameSpace ns, ffelexToken t, bool *found)
-{
-  ffename n;
-
-  for (n = ns->first; n != (ffename) &ns->first; n = n->next)
-    {
-      if (ffelex_token_strcmp (t, n->t) == 0)
-	{
-	  *found = TRUE;
-	  return n;
-	}
-    }
-
-  *found = FALSE;
-  return n;			/* (n == (ffename) &ns->first) */
-}
-
-/* Searches for and returns the matching ffename object, or creates a new
-   one (with a NULL ffesymbol) and returns that.  If last arg is TRUE,
-   check whether token meets character-content requirements (such as
-   "all characters must be uppercase", as determined by
-   ffesrc_bad_char_symbol (), issue diagnostic if it doesn't.  */
-
-ffename
-ffename_find (ffenameSpace ns, ffelexToken t)
-{
-  ffename n;
-  ffename newn;
-  bool found;
-
-  assert (ns != NULL);
-  assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
-			  || (ffelex_token_type (t) == FFELEX_typeNAMES)));
-
-  n = ffename_lookup_ (ns, t, &found);
-  if (found)
-    return n;
-
-  newn = malloc_new_ks (ns->pool, "FFENAME name", sizeof (*n));
-  newn->next = n;
-  newn->previous = n->previous;
-  n->previous = newn;
-  newn->previous->next = newn;
-  newn->t = ffelex_token_use (t);
-  newn->u.s = NULL;
-
-  return newn;
-}
-
-/* ffename_kill -- Kill name from name space
-
-   ffenameSpace ns;
-   ffename s;
-   ffename_kill(ns,s);
-
-   Removes the name from the name space.  */
-
-void
-ffename_kill (ffenameSpace ns, ffename n)
-{
-  assert (ns != NULL);
-  assert (n != NULL);
-
-  ffelex_token_kill (n->t);
-  n->next->previous = n->previous;
-  n->previous->next = n->next;
-  malloc_kill_ks (ns->pool, n, sizeof (*n));
-}
-
-/* ffename_lookup -- Look up name in name space
-
-   ffenameSpace ns;
-   ffelexToken t;
-   ffename s;
-   n = ffename_lookup(ns,t);
-
-   Searches for and returns the matching ffename object, or returns NULL.  */
-
-ffename
-ffename_lookup (ffenameSpace ns, ffelexToken t)
-{
-  ffename n;
-  bool found;
-
-  assert (ns != NULL);
-  assert ((t != NULL) && ((ffelex_token_type (t) == FFELEX_typeNAME)
-			  || (ffelex_token_type (t) == FFELEX_typeNAMES)));
-
-  n = ffename_lookup_ (ns, t, &found);
-
-  return found ? n : NULL;
-}
-
-/* ffename_space_drive_global -- Call given fn for each global in name space
-
-   ffenameSpace ns;
-   ffeglobal (*fn)();
-   ffename_space_drive_global(ns,fn);  */
-
-void
-ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal))
-{
-  ffename n;
-
-  if (ns == NULL)
-    return;
-
-  for (n = ns->first; n != (ffename) &ns->first; n = n->next)
-    {
-      if (n->u.g != NULL)
-	n->u.g = (*fn) (n->u.g);
-    }
-}
-
-/* ffename_space_drive_symbol -- Call given fn for each symbol in name space
-
-   ffenameSpace ns;
-   ffesymbol (*fn)();
-   ffename_space_drive_symbol(ns,fn);  */
-
-void
-ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol))
-{
-  ffename n;
-
-  if (ns == NULL)
-    return;
-
-  for (n = ns->first; n != (ffename) &ns->first; n = n->next)
-    {
-      if (n->u.s != NULL)
-	n->u.s = (*fn) (n->u.s);
-    }
-}
-
-/* ffename_space_kill -- Kill name space
-
-   ffenameSpace ns;
-   ffename_space_kill(ns);
-
-   Removes the names from the name space; kills the name space.	 */
-
-void
-ffename_space_kill (ffenameSpace ns)
-{
-  assert (ns != NULL);
-
-  while (ns->first != (ffename) &ns->first)
-    ffename_kill (ns, ns->first);
-
-  malloc_kill_ks (ns->pool, ns, sizeof (*ns));
-}
-
-/* ffename_space_new -- Create name space
-
-   ffenameSpace ns;
-   ns = ffename_space_new(malloc_pool_image());
-
-   Create new name space.  */
-
-ffenameSpace
-ffename_space_new (mallocPool pool)
-{
-  ffenameSpace ns;
-
-  ns = malloc_new_ks (pool, "FFENAME space", sizeof (*ns));
-  ns->first = (ffename) &ns->first;
-  ns->last = (ffename) &ns->first;
-  ns->pool = pool;
-
-  return ns;
-}
diff --git a/gcc/f/name.h b/gcc/f/name.h
deleted file mode 100644
index 4b18805..0000000
--- a/gcc/f/name.h
+++ /dev/null
@@ -1,109 +0,0 @@
-/* name.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      name.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_NAME_H
-#define GCC_F_NAME_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-typedef struct _ffename_ *ffename;
-typedef struct _ffename_space_ *ffenameSpace;
-
-/* Include files needed by this one. */
-
-#include "global.h"
-#include "lex.h"
-#include "malloc.h"
-#include "symbol.h"
-
-/* Structure definitions. */
-
-struct _ffename_
-  {
-    ffename next;
-    ffename previous;
-    ffelexToken t;
-    union
-      {
-	ffesymbol s;
-	ffeglobal g;
-      }
-    u;
-  };
-
-struct _ffename_space_
-  {
-    ffename first;
-    ffename last;
-    mallocPool pool;
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-ffename ffename_find (ffenameSpace ns, ffelexToken t);
-void ffename_kill (ffenameSpace ns, ffename n);
-ffename ffename_lookup (ffenameSpace ns, ffelexToken t);
-void ffename_space_drive_global (ffenameSpace ns, ffeglobal (*fn) (ffeglobal));
-void ffename_space_drive_symbol (ffenameSpace ns, ffesymbol (*fn) (ffesymbol));
-void ffename_space_kill (ffenameSpace ns);
-ffenameSpace ffename_space_new (mallocPool pool);
-
-/* Define macros. */
-
-#define ffename_first_token(n) ((n)->t)
-#define ffename_global(n) ((n)->u.g)
-#define ffename_init_0()
-#define ffename_init_1()
-#define ffename_init_2()
-#define ffename_init_3()
-#define ffename_init_4()
-#define ffename_set_global(n,glob) ((n)->u.g = (glob))
-#define ffename_set_symbol(n,sym) ((n)->u.s = (sym))
-#define ffename_symbol(n) ((n)->u.s)
-#define ffename_terminate_0()
-#define ffename_terminate_1()
-#define ffename_terminate_2()
-#define ffename_terminate_3()
-#define ffename_terminate_4()
-#define ffename_text(n) ffelex_token_text((n)->t)
-#define ffename_token(n) ((n)->t)
-#define ffename_where_filename(n) ffelex_token_where_filename((n)->t)
-#define ffename_where_filelinenum(n) ffelex_token_where_filelinenum((n)->t)
-#define ffename_where_line(n) ffelex_token_where_line((n)->t)
-#define ffename_where_column(n) ffelex_token_where_column((n)->t)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_NAME_H */
diff --git a/gcc/f/news.texi b/gcc/f/news.texi
deleted file mode 100644
index 28a3fac..0000000
--- a/gcc/f/news.texi
+++ /dev/null
@@ -1,3182 +0,0 @@
-@c Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002
-@c 2003
-@c  Free Software Foundation, Inc.
-@c This is part of the G77 manual.
-@c For copying conditions, see the file g77.texi.
-
-@c The text of this file appears in the file NEWS
-@c in the G77 distribution, as well as in the G77 manual.
-
-@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 last-update-news 2003-09-21
-
-@ifset DOC-NEWS
-@include root.texi
-@c The immediately following lines apply to the NEWS file
-@c which is derived from this file.
-@emph{Note:} This file is automatically generated from the files
-@file{news0.texi} and @file{news.texi}.
-@file{NEWS} is @emph{not} a source file,
-although it is normally included within source distributions.
-
-This file lists news about the @value{which-g77} version
-(and some other versions) of the GNU Fortran compiler.
-Copyright (C) @value{copyrights-news} Free Software Foundation, Inc.
-You may copy, distribute, and modify it freely as long as you preserve
-this copyright notice and permission notice.
-
-@node Top,,, (dir)
-@chapter News About GNU Fortran
-@end ifset
-
-@ifset DOC-G77
-@ifset USERVISONLY
-@node Changes
-@chapter User-visible Changes
-@cindex versions, recent
-@cindex recent versions
-@cindex changes, user-visible
-@cindex user-visible changes
-
-This chapter describes changes to @command{g77} that are visible
-to the programmers who actually write and maintain Fortran
-code they compile with @command{g77}.
-Information on changes to installation procedures,
-changes to the documentation, and bug fixes is
-not provided here, unless it is likely to affect how
-users use @command{g77}.
-@xref{News,,News About GNU Fortran}, for information on
-such changes to @command{g77}.
-@end ifset
-
-@ifclear USERVISONLY
-@node News
-@chapter News About GNU Fortran
-@cindex versions, recent
-@cindex recent versions
-@end ifclear
-@end ifset
-
-@ifclear USERVISONLY
-Changes made to recent versions of GNU Fortran are listed
-below, with the most recent version first.
-
-The changes are generally listed in order:
-
-@enumerate
-@item
-Code-generation and run-time-library bug-fixes
-
-@item
-Compiler and run-time-library crashes involving valid code
-that have been fixed
-
-@item
-New features
-
-@item
-Fixes and enhancements to existing features
-
-@item
-New diagnostics
-
-@item
-Internal improvements
-
-@item
-Miscellany
-@end enumerate
-
-This order is not strict---for example, some items
-involve a combination of these elements.
-@end ifclear
-
-Note that two variants of @command{g77} are tracked below.
-The @code{egcs} variant is described vis-a-vis
-previous versions of @code{egcs} and/or
-an official FSF version, as appropriate.
-Note that all such variants are obsolete @emph{as of July 1999} -
-the information is retained here only for its historical value.
-
-Therefore, @code{egcs} versions sometimes have multiple listings
-to help clarify how they differ from other versions,
-though this can make getting a complete picture
-of what a particular @code{egcs} version contains
-somewhat more difficult.
-
-@ifset DOC-G77
-For information on bugs in the @value{which-g77} version of @command{g77},
-see @ref{Known Bugs,,Known Bugs In GNU Fortran}.
-@end ifset
-
-@ifset DOC-BUGS
-For information on bugs in the @value{which-g77} version of @command{g77},
-see @file{@value{path-g77}/BUGS}.
-@end ifset
-
-@ifset DEVELOPMENT
-@emph{Warning:} The information below is still under development,
-and might not accurately reflect the @command{g77} code base
-of which it is a part.
-Efforts are made to keep it somewhat up-to-date,
-but they are particularly concentrated
-on any version of this information
-that is distributed as part of a @emph{released} @command{g77}.
-
-In particular, while this information is intended to apply to
-the @value{which-g77} version of @command{g77},
-only an official @emph{release} of that version
-is expected to contain documentation that is
-most consistent with the @command{g77} product in that version.
-
-Nevertheless, information on @emph{previous} releases of @command{g77}, below,
-is likely to be more up-to-date and accurate
-than the equivalent information that accompanied
-those releases,
-assuming the last-updated date of the information below
-is later than the dates of those releases.
-
-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
-Problem Reports fixed (in chronological order of submission):
-@table @code
-@item 1832
--list directed i/o overflow hangs, -fbounds-check doesn't detect
-@item 3924
-g77 generates code which is rejected by GAS if COFF debugging info is
-requested
-@item 6286
-Broken links on web pages
-@item 6367
-(libf2c) multiple repeat counts confuse namelist read into array
-@item 6491
-Logical operations error on logicals when using -fugly-logint
-@item 6742
-Generation of C++ Prototype for FORTRAN and extern "C"
-@item 7113
-Failure of g77.f-torture/execute/f90-intrinsic-bit.f -Os on irix6.5
-@item 7236
-(libf2c) OPEN(...,RECL=nnn,...) without ACCESS='DIRECT' should assume a direct
-access file
-@item 7278
-g77 "bug"; the executable misbehave (use of options -O2 -fno-automatic
-gave wrong results)
-@item 7384
-(libf2c) DATE_AND_TIME milliseconds field inactive on Windows
-@item 7388
-Incorrect output with 0-based array of characters
-@item 8587
-Double complex zero ** double precision number -> NaN instead of zero
-@item 9038
--ffixed-line-length-none -x f77-cpp-input gives: Warning: unknown register name line-length-none
-@item 9263
-ICE caused by invalid PARAMETER in implied DO loop
-@item 10197
-Direct access files not unformatted by default
-@item 10726
-Documentation for function IDATE Intrinsic (UNIX) is wrong [fixed in 3.3.1].
-@end table
-@item
-Richard Henderson (@email{rth@@redhat.com}) analyzed and improved the handling
-of (no-)aliasing information for dummy arguments and improved the optimization
-of induction variables in unrolled loops.
-@end itemize
-
-@heading In @code{GCC} 3.2 versus @code{GCC} 3.1:
-@itemize @bullet
-@item
-Problem Reports fixed (in chronological order of submission):
-@table @code
-@item 7681
-ICE in compensate_edge, at reg-stack.c:2591
-@item 8308
-gcc-3.x does not compile files with suffix .r (RATFOR) [Fixed in 3.2.1]
-@item 9258
-[3.2/3.3/3.4 regression] ICE in compensate_edge, at reg-stack.c:2589
-@end table
-@end itemize
-
-@heading In @code{GCC} 3.1 (formerly known as g77-0.5.27) versus @code{GCC} 3.0:
-@itemize @bullet
-@item
-Problem Reports fixed (in chronological order of submission):
-@table @code
-@item 947
-Data statement initialization with subscript of kind INTEGER*2
-@item 3743
-Reference to intrinsic `ISHFT' invalid
-@item 3807
-Function BESJN(integer,double) problems
-@item 3957
-g77 -pipe -xf77-cpp-input sends output to stdout
-@item 4279
-g77 -h" gives bogus output
-@item 4730
-ICE on valid input using CALL EXIT(%VAL(...))
-@item 4752
-g77 -v -c -xf77-version /dev/null -xnone causes ice
-@item 4885
-BACKSPACE example that doesn't work as of gcc/g77-3.0.x
-@item 5122
-g77 rejects accepted use of INTEGER*2 as type of DATA statement loop index
-@item 5397
-ICE on compiling source with 540 000 000 REAL array
-@item 5473
-ICE on BESJN(integer*8,real)
-@item 5837
-bug in loop unrolling
-@item 6106
-sparc-sun-solaris2.7 gcc-3.1 extra g77 testsuite failures w/-m64
-@item 6138
-Incorrect acces of integer*1 variables on PA
-@item 6304
-Failure of LAPACK test dtest on irix6.5 with -mabi=64 -O2
-@end table
-
-@item
-@command{g77} now has its man page generated from the texinfo documentation,
-to guarantee that it remains up to date.
-
-@item
-@command{g77} used to reject the following program on 32-bit targets:
-@smallexample
-PROGRAM PROG
-DIMENSION A(140 000 000)
-END
-@end smallexample
-with the message:
-@smallexample
-prog.f: In program `prog':
-prog.f:2: 
-         DIMENSION A(140 000 000)
-                   ^
-Array `a' at (^) is too large to handle
-@end smallexample
-because 140 000 000 REALs is larger than the largest bit-extent that can be
-expressed in 32 bits.  However, bit-sizes never play a role after offsets
-have been converted to byte addresses.  Therefore this check has been removed,
-and the limit is now 2 Gbyte of memory (around 530 000 000 REALs).
-Note: On GNU/Linux systems one has to compile and link programs that occupy
-more than 1 Gbyte statically, i.e.@: @code{g77 -static ...}.
-
-@item
-Based on work done by Juergen Pfeifer (@email{juergen.pfeifer@@gmx.net})
-libf2c is now a shared library.  One can still link in all objects with
-the program by specifying the @option{-static} option.
-
-@item
-Robert Anderson (@email{rwa@@alumni.princeton.edu}) thought up a two
-line change that enables g77 to compile such code as:
-@smallexample
-SUBROUTINE SUB(A, N)
-DIMENSION N(2)
-DIMENSION A(N(1),N(2))
-A(1,1) = 1.
-END
-@end smallexample
-Note the use of array elements in the bounds of the adjustable array A.
-
-@item
-George Helffrich (@email{george@@geo.titech.ac.jp}) implemented a change
-in substring index checking (when specifying @option{-fbounds-check})
-that permits the use of zero length substrings of the form
-@code{string(1:0)}.
-
-@item
-Based on code developed by Pedro Vazquez (@email{vazquez@@penelope.iqm.unicamp.br}),
-the @code{libf2c} library is now able to read and write files larger than
-2 Gbyte on 32-bit target machines, if the operating system supports this.
-@end itemize
-
-@heading In 0.5.26, @code{GCC} 3.0 versus @code{GCC} 2.95:
-@itemize @bullet
-@item
-When a REWIND was issued after a WRITE statement on an unformatted
-file, the implicit truncation was performed by copying the truncated
-file to /tmp and copying the result back.  This has been fixed by using
-the @code{ftruncate} OS function.  Thanks go to the GAMESS developers
-for bringing this to our attention.
-
-@item
-Using options @option{-g}, @option{-ggdb} or @option{-gdwarf[-2]} (where
-appropriate for your target) now also enables debugging information
-for COMMON BLOCK and EQUIVALENCE items to be emitted.
-Thanks go to Andrew Vaught (@email{andy@@xena.eas.asu.edu}) and
-George Helffrich (@email{george@@geology.bristol.ac.uk}) for
-fixing this longstanding problem.
-
-@item
-It is not necessary anymore to use the option @option{-femulate-complex}
-to compile Fortran code using COMPLEX arithmetic, even on 64-bit machines
-(like the Alpha).  This will improve code generation.
-
-@item
-INTRINSIC arithmetic functions are now treated as routines that do not
-depend on anything but their argument(s).  This enables further instruction
-scheduling, because it is known that they cannot read or modify arbitrary
-locations.
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 2000-12-05.
-
-This fixes a bug where a namelist containing initialization of LOGICAL
-items and a variable starting with T or F would be read incorrectly.
-
-@item
-The @code{TtyNam} intrinsics now set @var{Name} to all spaces (at run time)
-if the system has no @code{ttyname} implementation available.
-
-@item
-Upgrade to @code{libf2c} as of 1999-06-28.
-
-This fixes a bug whereby
-input to a @code{NAMELIST} read involving a repeat count,
-such as @samp{K(5)=10*3},
-was not properly handled by @code{libf2c}.
-The first item was written to @samp{K(5)},
-but the remaining nine were written elsewhere (still within the array),
-not necessarily starting at @samp{K(6)}.
-@end ifclear
-@end itemize
-
-@heading In 0.5.25, @code{GCC} 2.95 (@code{EGCS} 1.2) versus @code{EGCS} 1.1.2:
-@itemize @bullet
-@ifclear USERVISONLY
-@item
-@command{g77} no longer generates bad code for assignments,
-or other conversions,
-of @code{REAL} or @code{COMPLEX} constant expressions
-to type @code{INTEGER(KIND=2)}
-(often referred to as @code{INTEGER*8}).
-
-For example, @samp{INTEGER*8 J; J = 4E10} now works as documented.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer truncates @code{INTEGER(KIND=2)}
-(usually @code{INTEGER*8})
-subscript expressions when evaluating array references
-on systems with pointers widers than @code{INTEGER(KIND=1)}
-(such as Alphas).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer generates bad code
-for an assignment to a @code{COMPLEX} variable or array
-that partially overlaps one or more of the sources
-of the same assignment
-(a very rare construction).
-It now assigns through a temporary,
-in cases where such partial overlap is deemed possible.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@code{libg2c} (@code{libf2c}) no longer loses track
-of the file being worked on
-during a @code{BACKSPACE} operation.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@code{libg2c} (@code{libf2c}) fixes a bug whereby
-input to a @code{NAMELIST} read involving a repeat count,
-such as @samp{K(5)=10*3},
-was not properly handled by @code{libf2c}.
-The first item was written to @samp{K(5)},
-but the remaining nine were written elsewhere (still within the array),
-not necessarily starting at @samp{K(6)}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@c Tim Prince reported this, regarding the TEST_FPU benchmark.
-Automatic arrays now seem to be working on HP-UX systems.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @code{Date} intrinsic now returns the correct result
-on big-endian systems.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} so it no longer crashes when compiling
-I/O statements using keywords that define @code{INTEGER} values,
-such as @samp{IOSTAT=@var{j}},
-where @var{j} is other than default @code{INTEGER}
-(such as @code{INTEGER*2}).
-Instead, it issues a diagnostic.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} so it properly handles @samp{DATA A/@var{rpt}*@var{val}/},
-where @var{rpt} is not default @code{INTEGER}, such as @code{INTEGER*2},
-instead of producing a spurious diagnostic.
-Also fix @samp{DATA (A(I),I=1,N)},
-where @samp{N} is not default @code{INTEGER}
-to work instead of crashing @command{g77}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @option{-ax} option is now obeyed when compiling Fortran programs.
-(It is passed to the @file{f771} driver.)
-@end ifclear
-
-@item
-The new @option{-fbounds-check} option
-causes @command{g77} to compile run-time bounds checks
-of array subscripts, as well as of substring start and end points.
-
-@item
-@code{libg2c} now supports building as multilibbed library,
-which provides better support for systems
-that require options such as @option{-mieee}
-to work properly.
-
-@item
-Source file names with the suffixes @samp{.FOR} and @samp{.FPP}
-now are recognized by @command{g77}
-as if they ended in @samp{.for} and @samp{.fpp}, respectively.
-
-@item
-The order of arguments to the @emph{subroutine} forms of the
-@code{CTime}, @code{DTime}, @code{ETime}, and @code{TtyNam}
-intrinsics has been swapped.
-The argument serving as the returned value
-for the corresponding function forms
-now is the @emph{second} argument,
-making these consistent with the other subroutine forms
-of @code{libU77} intrinsics.
-
-@item
-@command{g77} now warns about a reference to an intrinsic
-that has an interface that is not Year 2000 (Y2K) compliant.
-Also, @code{libg2c} has been changed to increase the likelihood
-of catching references to the implementations of these intrinsics
-using the @code{EXTERNAL} mechanism
-(which would avoid the new warnings).
-
-@ifset DOC-G77
-@xref{Year 2000 (Y2K) Problems}, for more information.
-@end ifset
-
-@ifclear USERVISONLY
-@item
-@command{g77} now warns about a reference to a function
-when the corresponding @emph{subsequent} function program unit
-disagrees with the reference concerning the type of the function.
-@end ifclear
-
-@item
-@option{-fno-emulate-complex} is now the default option.
-This should result in improved performance
-of code that uses the @code{COMPLEX} data type.
-
-@cindex alignment
-@cindex double-precision performance
-@cindex -malign-double
-@item
-The @option{-malign-double} option
-now reliably aligns @emph{all} double-precision variables and arrays
-on Intel x86 targets.
-
-@ifclear USERVISONLY
-@item
-Even without the @option{-malign-double} option,
-@command{g77} reliably aligns local double-precision variables
-that are not in @code{EQUIVALENCE} areas
-and not @code{SAVE}'d.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} now open-codes (``inlines'') division of @code{COMPLEX} operands
-instead of generating a run-time call to
-the @code{libf2c} routines @code{c_div} or @code{z_div},
-unless the @option{-Os} option is specified.
-@end ifclear
-
-@item
-@command{g77} no longer generates code to maintain @code{errno},
-a C-language concept,
-when performing operations such as the @code{SqRt} intrinsic.
-
-@ifclear USERVISONLY
-@item
-@command{g77} developers can temporarily use
-the @option{-fflatten-arrays} option
-to compare how the compiler handles code generation
-using C-like constructs as compared to the
-Fortran-like method constructs normally used.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-A substantial portion of the @command{g77} front end's code-generation component
-was rewritten.
-It now generates code using facilities more robustly supported
-by the @command{gcc} back end.
-One effect of this rewrite is that some codes no longer produce
-a spurious ``label @var{lab} used before containing binding contour''
-message.
-@end ifclear
-
-@item
-Support for the @option{-fugly} option has been removed.
-
-@ifclear USERVISONLY
-@item
-Improve documentation and indexing,
-including information on Year 2000 (Y2K) compliance,
-and providing more information on internals of the front end.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1999-05-10.
-@end ifclear
-@end itemize
-
-@heading In 0.5.24 versus 0.5.23:
-
-There is no @command{g77} version 0.5.24 at this time,
-or planned.
-0.5.24 is the version number designated for bug fixes and,
-perhaps, some new features added,
-to 0.5.23.
-Version 0.5.23 requires @command{gcc} 2.8.1,
-as 0.5.24 was planned to require.
-
-Due to @code{EGCS} becoming @code{GCC}
-(which is now an acronym for ``GNU Compiler Collection''),
-and @code{EGCS} 1.2 becoming officially designated @code{GCC} 2.95,
-there seems to be no need for an actual 0.5.24 release.
-
-To reduce the confusion already resulting from use of 0.5.24
-to designate @command{g77} versions within @code{EGCS} versions 1.0 and 1.1,
-as well as in versions of @command{g77} documentation and notices
-during that period,
-``mainline'' @command{g77} version numbering resumes
-at 0.5.25 with @code{GCC} 2.95 (@code{EGCS} 1.2),
-skipping over 0.5.24 as a placeholder version number.
-
-To repeat, there is no @command{g77} 0.5.24, but there is now a 0.5.25.
-Please remain calm and return to your keypunch units.
-
-@c 1999-03-15: EGCS 1.1.2 released.
-@heading In @code{EGCS} 1.1.2 versus @code{EGCS} 1.1.1:
-@ifclear USERVISONLY
-@itemize @bullet
-@item
-Fix the @code{IDate} intrinsic (VXT) (in @code{libg2c})
-so the returned year is in the documented, non-Y2K-compliant range
-of 0-99,
-instead of being returned as 100 in the year 2000.
-
-@ifset DOC-G77
-@xref{IDate Intrinsic (VXT)},
-for more information.
-@end ifset
-
-@item
-Fix the @code{Date_and_Time} intrinsic (in @code{libg2c})
-to return the milliseconds value properly
-in @var{Values}(8).
-
-@item
-Fix the @code{LStat} intrinsic (in @code{libg2c})
-to return device-ID information properly
-in @var{SArray}(7).
-
-@item
-Improve documentation.
-@end itemize
-@end ifclear
-
-@c 1998-12-04: EGCS 1.1.1 released.
-@heading In @code{EGCS} 1.1.1 versus @code{EGCS} 1.1:
-@ifclear USERVISONLY
-@itemize @bullet
-@item
-Fix @code{libg2c} so it performs an implicit @code{ENDFILE} operation
-(as appropriate)
-whenever a @code{REWIND} is done.
-
-(This bug was introduced in 0.5.23 and @code{egcs} 1.1 in
-@command{g77}'s version of @code{libf2c}.)
-
-@item
-Fix @code{libg2c} so it no longer crashes with a spurious diagnostic
-upon doing any I/O following a direct formatted write.
-
-(This bug was introduced in 0.5.23 and @code{egcs} 1.1 in
-@command{g77}'s version of @code{libf2c}.)
-
-@item
-Fix @command{g77} so it no longer crashes compiling references
-to the @code{Rand} intrinsic on some systems.
-
-@item
-Fix @command{g77} portion of installation process so it works
-better on some systems
-(those with shells requiring @samp{else true} clauses
-on @code{if} constructs
-for the completion code to be set properly).
-@end itemize
-@end ifclear
-
-@c 1998-09-03: EGCS 1.1 released.
-@heading In @code{EGCS} 1.1 versus @code{EGCS} 1.0.3:
-@itemize @bullet
-@ifclear USERVISONLY
-@item
-Fix bugs in the @code{libU77} intrinsic @code{HostNm}
-that wrote one byte beyond the end of its @code{CHARACTER}
-argument,
-and in the @code{libU77} intrinsics
-@code{GMTime} and @code{LTime}
-that overwrote their arguments.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Assumed arrays with negative bounds
-(such as @samp{REAL A(-1:*)})
-no longer elicit spurious diagnostics from @command{g77},
-even on systems with pointers having
-different sizes than integers.
-
-This bug is not known to have existed in any
-recent version of @command{gcc}.
-It was introduced in an early release of @code{egcs}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Valid combinations of @code{EXTERNAL},
-passing that external as a dummy argument
-without explicitly giving it a type,
-and, in a subsequent program unit,
-referencing that external as
-an external function with a different type
-no longer crash @command{g77}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@code{CASE DEFAULT} no longer crashes @command{g77}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @option{-Wunused} option no longer issues a spurious
-warning about the ``master'' procedure generated by
-@command{g77} for procedures containing @code{ENTRY} statements.
-@end ifclear
-
-@item
-Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a
-compile-time constant @code{INTEGER} expression.
-
-@item
-Fix @command{g77} @option{-g} option so procedures that
-use @code{ENTRY} can be stepped through, line by line,
-in @command{gdb}.
-
-@item
-Allow any @code{REAL} argument to intrinsics
-@code{Second} and @code{CPU_Time}.
-
-@item
-Use @code{tempnam}, if available, to open scratch files
-(as in @samp{OPEN(STATUS='SCRATCH')})
-so that the @code{TMPDIR} environment variable,
-if present, is used.
-
-@item
-@command{g77}'s version of @code{libf2c} separates out
-the setting of global state
-(such as command-line arguments and signal handling)
-from @file{main.o} into distinct, new library
-archive members.
-
-This should make it easier to write portable applications
-that have their own (non-Fortran) @code{main()} routine
-properly set up the @code{libf2c} environment, even
-when @code{libf2c} (now @code{libg2c}) is a shared library.
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer installs the @file{f77} command
-and @file{f77.1} man page
-in the @file{/usr} or @file{/usr/local} hierarchy,
-even if the @file{f77-install-ok} file exists
-in the source or build directory.
-See the installation documentation for more information.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer installs the @file{libf2c.a} library
-and @file{f2c.h} include file
-in the @file{/usr} or @file{/usr/local} hierarchy,
-even if the @file{f2c-install-ok} or @file{f2c-exists-ok} files exist
-in the source or build directory.
-See the installation documentation for more information.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @file{libf2c.a} library produced by @command{g77} has been
-renamed to @file{libg2c.a}.
-It is installed only in the @command{gcc} ``private''
-directory hierarchy, @file{gcc-lib}.
-This allows system administrators and users to choose which
-version of the @code{libf2c} library from @code{netlib} they
-wish to use on a case-by-case basis.
-See the installation documentation for more information.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @file{f2c.h} include (header) file produced by @command{g77}
-has been renamed to @file{g2c.h}.
-It is installed only in the @command{gcc} ``private''
-directory hierarchy, @file{gcc-lib}.
-This allows system administrators and users to choose which
-version of the include file from @code{netlib} they
-wish to use on a case-by-case basis.
-See the installation documentation for more information.
-@end ifclear
-
-@item
-The @command{g77} command now expects the run-time library
-to be named @code{libg2c.a} instead of @code{libf2c.a},
-to ensure that a version other than the one built and
-installed as part of the same @command{g77} version is picked up.
-
-@ifclear USERVISONLY
-@item
-During the configuration and build process,
-@command{g77} creates subdirectories it needs only as it
-needs them.
-Other cleaning up of the configuration and build process
-has been performed as well.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@code{install-info} now used to update the directory of
-Info documentation to contain an entry for @command{g77}
-(during installation).
-@end ifclear
-
-@item
-Some diagnostics have been changed from warnings to errors,
-to prevent inadvertent use of the resulting, probably buggy,
-programs.
-These mostly include diagnostics about use of unsupported features
-in the @code{OPEN}, @code{INQUIRE}, @code{READ}, and
-@code{WRITE} statements,
-and about truncations of various sorts of constants.
-
-@ifclear USERVISONLY
-@item
-Improve compilation of @code{FORMAT} expressions so that
-a null byte is appended to the last operand if it
-is a constant.
-This provides a cleaner run-time diagnostic as provided
-by @code{libf2c} for statements like @samp{PRINT '(I1', 42}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve documentation and indexing.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The upgrade to @code{libf2c} as of 1998-06-18
-should fix a variety of problems, including
-those involving some uses of the @code{T} format
-specifier, and perhaps some build (porting) problems
-as well.
-@end ifclear
-@end itemize
-
-@c 1998-09-03: EGCS 1.1 released.
-@heading In @code{EGCS} 1.1 versus @command{g77} 0.5.23:
-@itemize @bullet
-@ifclear USERVISONLY
-@cindex DNRM2
-@cindex stack, 387 coprocessor
-@cindex Intel x86
-@cindex -O2
-@item
-Fix a code-generation bug that afflicted
-Intel x86 targets when @option{-O2} was specified
-compiling, for example, an old version of
-the @code{DNRM2} routine.
-
-The x87 coprocessor stack was being
-mismanaged in cases involving assigned @code{GOTO}
-and @code{ASSIGN}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer produces incorrect code
-and initial values
-for @code{EQUIVALENCE} and @code{COMMON}
-aggregates that, due to ``unnatural'' ordering of members
-vis-a-vis their types, require initial padding.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash compiling code
-containing the construct @samp{CMPLX(0.)} or similar.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer crashes when compiling code
-containing specification statements such as
-@samp{INTEGER(KIND=7) PTR}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer crashes when compiling code
-such as @samp{J = SIGNAL(1, 2)}.
-@end ifclear
-
-@item
-@command{g77} now treats @samp{%LOC(@var{expr})} and
-@samp{LOC(@var{expr})} as ``ordinary'' expressions
-when they are used as arguments in procedure calls.
-This change applies only to global (filewide) analysis,
-making it consistent with
-how @command{g77} actually generates code
-for these cases.
-
-Previously, @command{g77} treated these expressions
-as denoting special ``pointer'' arguments
-for the purposes of filewide analysis.
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash
-(or apparently infinite run-time)
-when compiling certain complicated expressions
-involving @code{COMPLEX} arithmetic
-(especially multiplication).
-@end ifclear
-
-@cindex alignment
-@cindex double-precision performance
-@cindex -malign-double
-@item
-Align static double-precision variables and arrays
-on Intel x86 targets
-regardless of whether @option{-malign-double} is specified.
-
-Generally, this affects only local variables and arrays
-having the @code{SAVE} attribute
-or given initial values via @code{DATA}.
-
-@item
-The @command{g77} driver now ensures that @option{-lg2c}
-is specified in the link phase prior to any
-occurrence of @option{-lm}.
-This prevents accidentally linking to a routine
-in the SunOS4 @option{-lm} library
-when the generated code wants to link to the one
-in @code{libf2c} (@code{libg2c}).
-
-@item
-@command{g77} emits more debugging information when
-@option{-g} is used.
-
-This new information allows, for example,
-@kbd{which __g77_length_a} to be used in @command{gdb}
-to determine the type of the phantom length argument
-supplied with @code{CHARACTER} variables.
-
-This information pertains to internally-generated
-type, variable, and other information,
-not to the longstanding deficiencies vis-a-vis
-@code{COMMON} and @code{EQUIVALENCE}.
-
-@item
-The F90 @code{Date_and_Time} intrinsic now is
-supported.
-
-@item
-The F90 @code{System_Clock} intrinsic allows
-the optional arguments (except for the @code{Count}
-argument) to be omitted.
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1998-06-18.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve documentation and indexing.
-@end ifclear
-@end itemize
-
-@ifset DOC-NEWS
-@heading In previous versions:
-
-Information on previous versions is not provided
-in this @file{@value{path-g77}/NEWS} file,
-to keep it short.
-See @file{@value{path-g77}/news.texi},
-or any of its other derivations
-(Info, HTML, dvi forms)
-for such information.
-@end ifset
-
-@ifclear DOC-NEWS
-@c 1998-05-20: 0.5.23 released.
-@heading In 0.5.23 versus 0.5.22:
-@itemize @bullet
-@item
-This release contains several regressions against
-version 0.5.22 of @command{g77}, due to using the
-``vanilla'' @command{gcc} back end instead of patching
-it to fix a few bugs and improve performance in a
-few cases.
-
-Features that have been dropped from this version
-of @command{g77} due to their being implemented
-via @command{g77}-specific patches to the @command{gcc}
-back end in previous releases include:
-
-@itemize @minus
-@item
-Support for @code{__restrict__} keyword,
-the options @option{-fargument-alias}, @option{-fargument-noalias},
-and @option{-fargument-noalias-global},
-and the corresponding alias-analysis code.
-
-(@code{egcs} has the alias-analysis
-code, but not the @code{__restrict__} keyword.
-@code{egcs} @command{g77} users benefit from the alias-analysis
-code despite the lack of the @code{__restrict__} keyword,
-which is a C-language construct.)
-
-@item
-Support for the GNU compiler options
-@option{-fmove-all-movables},
-@option{-freduce-all-givs},
-and @option{-frerun-loop-opt}.
-
-(@code{egcs} supports these options.
-@command{g77} users of @code{egcs} benefit from them even if
-they are not explicitly specified,
-because the defaults are optimized for @command{g77} users.)
-
-@item
-Support for the @option{-W} option warning about
-integer division by zero.
-
-@item
-The Intel x86-specific option @option{-malign-double}
-applying to stack-allocated data
-as well as statically-allocate data.
-@end itemize
-
-@ifclear USERVISONLY
-Note that the @file{gcc/f/gbe/} subdirectory has been removed
-from this distribution as a result of @command{g77} no longer
-including patches for the @command{gcc} back end.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix bugs in the @code{libU77} intrinsic @code{HostNm}
-that wrote one byte beyond the end of its @code{CHARACTER}
-argument,
-and in the @code{libU77} intrinsics
-@code{GMTime} and @code{LTime}
-that overwrote their arguments.
-@end ifclear
-
-@item
-Support @command{gcc} version 2.8,
-and remove support for prior versions of @command{gcc}.
-
-@cindex -@w{}-driver option
-@cindex @command{g77} options, -@w{}-driver
-@cindex options, -@w{}-driver
-@item
-Remove support for the @option{--driver} option,
-as @command{g77} now does all the driving,
-just like @command{gcc}.
-
-@ifclear USERVISONLY
-@item
-@code{CASE DEFAULT} no longer crashes @command{g77}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Valid combinations of @code{EXTERNAL},
-passing that external as a dummy argument
-without explicitly giving it a type,
-and, in a subsequent program unit,
-referencing that external as
-an external function with a different type
-no longer crash @command{g77}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer installs the @file{f77} command
-and @file{f77.1} man page
-in the @file{/usr} or @file{/usr/local} hierarchy,
-even if the @file{f77-install-ok} file exists
-in the source or build directory.
-See the installation documentation for more information.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} no longer installs the @file{libf2c.a} library
-and @file{f2c.h} include file
-in the @file{/usr} or @file{/usr/local} hierarchy,
-even if the @file{f2c-install-ok} or @file{f2c-exists-ok} files exist
-in the source or build directory.
-See the installation documentation for more information.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @file{libf2c.a} library produced by @command{g77} has been
-renamed to @file{libg2c.a}.
-It is installed only in the @command{gcc} ``private''
-directory hierarchy, @file{gcc-lib}.
-This allows system administrators and users to choose which
-version of the @code{libf2c} library from @code{netlib} they
-wish to use on a case-by-case basis.
-See the installation documentation for more information.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @file{f2c.h} include (header) file produced by @command{g77}
-has been renamed to @file{g2c.h}.
-It is installed only in the @command{gcc} ``private''
-directory hierarchy, @file{gcc-lib}.
-This allows system administrators and users to choose which
-version of the include file from @code{netlib} they
-wish to use on a case-by-case basis.
-See the installation documentation for more information.
-@end ifclear
-
-@item
-The @command{g77} command now expects the run-time library
-to be named @code{libg2c.a} instead of @code{libf2c.a},
-to ensure that a version other than the one built and
-installed as part of the same @command{g77} version is picked up.
-
-@ifclear USERVISONLY
-@item
-The @option{-Wunused} option no longer issues a spurious
-warning about the ``master'' procedure generated by
-@command{g77} for procedures containing @code{ENTRY} statements.
-@end ifclear
-
-@item
-@command{g77}'s version of @code{libf2c} separates out
-the setting of global state
-(such as command-line arguments and signal handling)
-from @file{main.o} into distinct, new library
-archive members.
-
-This should make it easier to write portable applications
-that have their own (non-Fortran) @code{main()} routine
-properly set up the @code{libf2c} environment, even
-when @code{libf2c} (now @code{libg2c}) is a shared library.
-
-@ifclear USERVISONLY
-@item
-During the configuration and build process,
-@command{g77} creates subdirectories it needs only as it
-needs them, thus avoiding unnecessary creation of, for example,
-@file{stage1/f/runtime} when doing a non-bootstrap build.
-Other cleaning up of the configuration and build process
-has been performed as well.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@code{install-info} now used to update the directory of
-Info documentation to contain an entry for @command{g77}
-(during installation).
-@end ifclear
-
-@item
-Some diagnostics have been changed from warnings to errors,
-to prevent inadvertent use of the resulting, probably buggy,
-programs.
-These mostly include diagnostics about use of unsupported features
-in the @code{OPEN}, @code{INQUIRE}, @code{READ}, and
-@code{WRITE} statements,
-and about truncations of various sorts of constants.
-
-@ifclear USERVISONLY
-@item
-Improve documentation and indexing.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1998-04-20.
-
-This should fix a variety of problems, including
-those involving some uses of the @code{T} format
-specifier, and perhaps some build (porting) problems
-as well.
-@end ifclear
-@end itemize
-
-@c 1998-03-16: 0.5.22 released.
-@heading In 0.5.22 versus 0.5.21:
-@itemize @bullet
-@ifclear USERVISONLY
-@item
-Fix code generation for iterative @code{DO} loops that
-have one or more references to the iteration variable,
-or to aliases of it, in their control expressions.
-For example, @samp{DO 10 J=2,J} now is compiled correctly.
-@end ifclear
-
-@ifclear USERVISONLY
-@cindex DNRM2
-@cindex stack, 387 coprocessor
-@cindex Intel x86
-@cindex -O2
-@item
-Fix a code-generation bug that afflicted
-Intel x86 targets when @option{-O2} was specified
-compiling, for example, an old version of
-the @code{DNRM2} routine.
-
-The x87 coprocessor stack was being
-mismanaged in cases involving assigned @code{GOTO}
-and @code{ASSIGN}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @code{DTime} intrinsic so as not to truncate
-results to integer values (on some systems).
-@end ifclear
-
-@item
-Fix @code{Signal} intrinsic so it offers portable
-support for 64-bit systems (such as Digital Alphas
-running GNU/Linux).
-
-@ifclear USERVISONLY
-@item
-Fix run-time crash involving @code{NAMELIST} on 64-bit
-machines such as Alphas.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} version of @code{libf2c} so it no longer
-produces a spurious @samp{I/O recursion} diagnostic at run time
-when an I/O operation (such as @samp{READ *,I}) is interrupted
-in a manner that causes the program to be terminated
-via the @code{f_exit} routine (such as via @kbd{C-c}).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash triggered by @code{CASE} statement with
-an omitted lower or upper bound.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash compiling references to @code{CPU_Time}
-intrinsic.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash
-(or apparently infinite run-time)
-when compiling certain complicated expressions
-involving @code{COMPLEX} arithmetic
-(especially multiplication).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash on statements such as
-@samp{PRINT *, (REAL(Z(I)),I=1,2)}, where
-@samp{Z} is @code{DOUBLE COMPLEX}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix a @command{g++} crash.
-@end ifclear
-
-@item
-Support @samp{FORMAT(I<@var{expr}>)} when @var{expr} is a
-compile-time constant @code{INTEGER} expression.
-
-@item
-Fix @command{g77} @option{-g} option so procedures that
-use @code{ENTRY} can be stepped through, line by line,
-in @command{gdb}.
-
-@ifclear USERVISONLY
-@item
-Fix a profiling-related bug in @command{gcc} back end for
-Intel x86 architecture.
-@end ifclear
-
-@item
-Allow any @code{REAL} argument to intrinsics
-@code{Second} and @code{CPU_Time}.
-
-@item
-Allow any numeric argument to intrinsics
-@code{Int2} and @code{Int8}.
-
-@item
-Use @code{tempnam}, if available, to open scratch files
-(as in @samp{OPEN(STATUS='SCRATCH')})
-so that the @code{TMPDIR} environment variable,
-if present, is used.
-
-@item
-Rename the @command{gcc} keyword @code{restrict} to
-@code{__restrict__}, to avoid rejecting valid, existing,
-C programs.
-Support for @code{restrict} is now more like support
-for @code{complex}.
-
-@ifclear USERVISONLY
-@item
-Fix @option{-fpedantic} to not reject procedure invocations
-such as @samp{I=J()} and @samp{CALL FOO()}.
-@end ifclear
-
-@item
-Fix @option{-fugly-comma} to affect invocations of
-only external procedures.
-Restore rejection of gratuitous trailing omitted
-arguments to intrinsics, as in @samp{I=MAX(3,4,,)}.
-
-@item
-Fix compiler so it accepts @option{-fgnu-intrinsics-*} and
-@option{-fbadu77-intrinsics-*} options.
-
-@ifclear USERVISONLY
-@item
-Improve diagnostic messages from @code{libf2c}
-so it is more likely that the printing of the
-active format string is limited to the string,
-with no trailing garbage being printed.
-
-(Unlike @command{f2c}, @command{g77} did not append
-a null byte to its compiled form of every
-format string specified via a @code{FORMAT} statement.
-However, @command{f2c} would exhibit the problem
-anyway for a statement like @samp{PRINT '(I)garbage', 1}
-by printing @samp{(I)garbage} as the format string.)
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve compilation of @code{FORMAT} expressions so that
-a null byte is appended to the last operand if it
-is a constant.
-This provides a cleaner run-time diagnostic as provided
-by @code{libf2c} for statements like @samp{PRINT '(I1', 42}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix various crashes involving code with diagnosed errors.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix cross-compilation bug when configuring @code{libf2c}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve diagnostics.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve documentation and indexing.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1997-09-23.
-This fixes a formatted-I/O bug that afflicted
-64-bit systems with 32-bit integers
-(such as Digital Alpha running GNU/Linux).
-@end ifclear
-@end itemize
-
-@c 1998-03-18: EGCS 1.0.2 released.
-@heading In @code{EGCS} 1.0.2 versus @code{EGCS} 1.0.1:
-@itemize @bullet
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash triggered by @code{CASE} statement with
-an omitted lower or upper bound.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} crash on statements such as
-@samp{PRINT *, (REAL(Z(I)),I=1,2)}, where
-@samp{Z} is @code{DOUBLE COMPLEX}.
-@end ifclear
-
-@ifclear USERVISONLY
-@cindex ELF support
-@cindex support, ELF
-@cindex -fPIC option
-@cindex options, -fPIC
-@item
-Fix @option{-fPIC} (such as compiling for ELF targets)
-on the Intel x86 architecture target
-so invalid assembler code is no longer produced.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @option{-fpedantic} to not reject procedure invocations
-such as @samp{I=J()} and @samp{CALL FOO()}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @option{-fugly-comma} to affect invocations of
-only external procedures.
-Restore rejection of gratuitous trailing omitted
-arguments to intrinsics, as in @samp{I=MAX(3,4,,)}.
-@end ifclear
-
-@item
-Fix compiler so it accepts @option{-fgnu-intrinsics-*} and
-@option{-fbadu77-intrinsics-*} options.
-@end itemize
-
-@c 1998-01-06: EGCS 1.0.1 released.
-@heading In @code{EGCS} 1.0.1 versus @code{EGCS} 1.0:
-@ifclear USERVISONLY
-@itemize @bullet
-@item
-Fix run-time crash involving @code{NAMELIST} on 64-bit
-machines such as Alphas.
-@end itemize
-@end ifclear
-
-@c 1997-12-03: EGCS 1.0 released.
-@heading In @code{EGCS} 1.0 versus @command{g77} 0.5.21:
-@itemize @bullet
-@item
-Version 1.0 of @code{egcs}
-contains several regressions against
-version 0.5.21 of @command{g77},
-due to using the
-``vanilla'' @command{gcc} back end instead of patching
-it to fix a few bugs and improve performance in a
-few cases.
-
-Features that have been dropped from this version
-of @command{g77} due to their being implemented
-via @command{g77}-specific patches to the @command{gcc}
-back end in previous releases include:
-
-@itemize @minus
-@item
-Support for the C-language @code{restrict} keyword.
-
-@item
-Support for the @option{-W} option warning about
-integer division by zero.
-
-@item
-The Intel x86-specific option @option{-malign-double}
-applying to stack-allocated data
-as well as statically-allocate data.
-@end itemize
-
-@ifclear USERVISONLY
-Note that the @file{gcc/f/gbe/} subdirectory has been removed
-from this distribution as a result of @command{g77}
-being fully integrated with
-the @code{egcs} variant of the @command{gcc} back end.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix code generation for iterative @code{DO} loops that
-have one or more references to the iteration variable,
-or to aliases of it, in their control expressions.
-For example, @samp{DO 10 J=2,J} now is compiled correctly.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @code{DTime} intrinsic so as not to truncate
-results to integer values (on some systems).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@c Toon Moene discovered these.
-Some Fortran code, miscompiled
-by @command{g77} built on @command{gcc} version 2.8.1
-on m68k-next-nextstep3 configurations
-when using the @option{-O2} option,
-is now compiled correctly.
-It is believed that a C function known to miscompile
-on that configuration
-when using the @samp{-O2 -funroll-loops} options
-also is now compiled correctly.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Remove support for non-@code{egcs} versions of @command{gcc}.
-@end ifclear
-
-@cindex -@w{}-driver option
-@cindex @command{g77} options, -@w{}-driver
-@cindex options, -@w{}-driver
-@item
-Remove support for the @option{--driver} option,
-as @command{g77} now does all the driving,
-just like @command{gcc}.
-
-@item
-Allow any numeric argument to intrinsics
-@code{Int2} and @code{Int8}.
-
-@ifclear USERVISONLY
-@item
-Improve diagnostic messages from @code{libf2c}
-so it is more likely that the printing of the
-active format string is limited to the string,
-with no trailing garbage being printed.
-
-(Unlike @command{f2c}, @command{g77} did not append
-a null byte to its compiled form of every
-format string specified via a @code{FORMAT} statement.
-However, @code{f2c} would exhibit the problem
-anyway for a statement like @samp{PRINT '(I)garbage', 1}
-by printing @samp{(I)garbage} as the format string.)
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1997-09-23.
-This fixes a formatted-I/O bug that afflicted
-64-bit systems with 32-bit integers
-(such as Digital Alpha running GNU/Linux).
-@end ifclear
-@end itemize
-
-@c 1997-09-09: 0.5.21 released.
-@heading In 0.5.21:
-@itemize @bullet
-@ifclear USERVISONLY
-@item
-Fix a code-generation bug introduced by 0.5.20
-caused by loop unrolling (by specifying
-@option{-funroll-loops} or similar).
-This bug afflicted all code compiled by
-version 2.7.2.2.f.2 of @command{gcc} (C, C++,
-Fortran, and so on).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix a code-generation bug manifested when
-combining local @code{EQUIVALENCE} with a
-@code{DATA} statement that follows
-the first executable statement (or is
-treated as an executable-context statement
-as a result of using the @option{-fpedantic}
-option).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix a compiler crash that occurred when an
-integer division by a constant zero is detected.
-Instead, when the @option{-W} option is specified,
-the @command{gcc} back end issues a warning about such a case.
-This bug afflicted all code compiled by
-version 2.7.2.2.f.2 of @command{gcc} (C, C++,
-Fortran, and so on).
-@end ifclear
-@ifset USERVISONLY
-@item
-When the @option{-W} option is specified, @command{gcc}, @command{g77},
-and other GNU compilers that incorporate the @command{gcc}
-back end as modified by @command{g77}, issue
-a warning about integer division by constant zero.
-@end ifset
-
-@ifclear USERVISONLY
-@item
-Fix a compiler crash that occurred in some cases
-of procedure inlining.
-(Such cases became more frequent in 0.5.20.)
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix a compiler crash resulting from using @code{DATA}
-or similar to initialize a @code{COMPLEX} variable or
-array to zero.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix compiler crashes involving use of @code{AND}, @code{OR},
-or @code{XOR} intrinsics.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix compiler bug triggered when using a @code{COMMON}
-or @code{EQUIVALENCE} variable
-as the target of an @code{ASSIGN}
-or assigned-@code{GOTO} statement.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix compiler crashes due to using the name of a some
-non-standard intrinsics (such as @code{FTell} or
-@code{FPutC}) as such and as the name of a procedure
-or common block.
-Such dual use of a name in a program is allowed by
-the standard.
-@end ifclear
-
-@c @command{g77}'s version of @code{libf2c} has been modified
-@c so that the external names of library's procedures do not
-@c conflict with names used for Fortran procedures compiled
-@c by @command{g77}.
-@c An additional layer of jacket procedures has been added
-@c to @code{libf2c} to map the old names to the new names,
-@c for automatic use by programs that interface to the
-@c library procedures via the external-procedure mechanism.
-@c 
-@c For example, the intrinsic @code{FPUTC} previously was
-@c implemented by @command{g77} as a call to the @code{libf2c}
-@c routine @code{fputc_}.
-@c This would conflict with a Fortran procedure named @code{FPUTC}
-@c (using default compiler options), and this conflict
-@c would cause a crash under certain circumstances.
-@c 
-@c Now, the intrinsic @code{FPUTC} calls @code{G77_fputc_0},
-@c which does not conflict with the @code{fputc_} external
-@c that implements a Fortran procedure named @code{FPUTC}.
-@c 
-@c Programs that refer to @code{FPUTC} as an external procedure
-@c without supplying their own implementation will link to
-@c the new @code{libf2c} routine @code{fputc_}, which is
-@c simply a jacket routine that calls @code{G77_fputc_0}.
-
-@ifclear USERVISONLY
-@item
-Place automatic arrays on the stack, even if
-@code{SAVE} or the @option{-fno-automatic} option
-is in effect.
-This avoids a compiler crash in some cases.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The @option{-malign-double} option now reliably aligns
-@code{DOUBLE PRECISION} optimally on Pentium and
-Pentium Pro architectures (586 and 686 in @command{gcc}).
-@end ifclear
-
-@item
-New option @option{-Wno-globals} disables warnings
-about ``suspicious'' use of a name both as a global
-name and as the implicit name of an intrinsic, and
-warnings about disagreements over the number or natures of
-arguments passed to global procedures, or the
-natures of the procedures themselves.
-
-The default is to issue such warnings, which are
-new as of this version of @command{g77}.
-
-@item
-New option @option{-fno-globals} disables diagnostics
-about potentially fatal disagreements
-analysis problems, such as disagreements over the
-number or natures of arguments passed to global
-procedures, or the natures of those procedures themselves.
-
-The default is to issue such diagnostics and flag
-the compilation as unsuccessful.
-With this option, the diagnostics are issued as
-warnings, or, if @option{-Wno-globals} is specified,
-are not issued at all.
-
-This option also disables inlining of global procedures,
-to avoid compiler crashes resulting from coding errors
-that these diagnostics normally would identify.
-
-@ifclear USERVISONLY
-@item
-Diagnose cases where a reference to a procedure
-disagrees with the type of that procedure, or
-where disagreements about the number or nature
-of arguments exist.
-This avoids a compiler crash.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix parsing bug whereby @command{g77} rejected a
-second initialization specification immediately
-following the first's closing @samp{/} without
-an intervening comma in a @code{DATA} statement,
-and the second specification was an implied-DO list.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve performance of the @command{gcc} back end so
-certain complicated expressions involving @code{COMPLEX}
-arithmetic (especially multiplication) don't appear to
-take forever to compile.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix a couple of profiling-related bugs in @command{gcc}
-back end.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Integrate GNU Ada's (GNAT's) changes to the back end,
-which consist almost entirely of bug fixes.
-These fixes are circa version 3.10p of GNAT.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Include some other @command{gcc} fixes that seem useful in
-@command{g77}'s version of @command{gcc}.
-(See @file{gcc/ChangeLog} for details---compare it
-to that file in the vanilla @code{gcc-2.7.2.3.tar.gz}
-distribution.)
-@end ifclear
-
-@item
-Fix @code{libU77} routines that accept file and other names
-to strip trailing blanks from them, for consistency
-with other implementations.
-Blanks may be forcibly appended to such names by
-appending a single null character (@samp{CHAR(0)})
-to the significant trailing blanks.
-
-@item
-Fix @code{CHMOD} intrinsic to work with file names
-that have embedded blanks, commas, and so on.
-
-@item
-Fix @code{SIGNAL} intrinsic so it accepts an
-optional third @code{Status} argument.
-
-@ifclear USERVISONLY
-@item
-Fix @code{IDATE()} intrinsic subroutine (VXT form)
-so it accepts arguments in the correct order.
-Documentation fixed accordingly, and for
-@code{GMTIME()} and @code{LTIME()} as well.
-@end ifclear
-
-@item
-Make many changes to @code{libU77} intrinsics to
-support existing code more directly.
-
-Such changes include allowing both subroutine and
-function forms of many routines, changing @code{MCLOCK()}
-and @code{TIME()} to return @code{INTEGER(KIND=1)} values,
-introducing @code{MCLOCK8()} and @code{TIME8()} to
-return @code{INTEGER(KIND=2)} values,
-and placing functions that are intended to perform
-side effects in a new intrinsic group, @code{badu77}.
-
-@ifclear USERVISONLY
-@item
-Improve @code{libU77} so it is more portable.
-@end ifclear
-
-@item
-Add options @option{-fbadu77-intrinsics-delete},
-@option{-fbadu77-intrinsics-hide}, and so on.
-
-@ifclear USERVISONLY
-@item
-Fix crashes involving diagnosed or invalid code.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-@command{g77} and @command{gcc} now do a somewhat better
-job detecting and diagnosing arrays that are too
-large to handle before these cause diagnostics
-during the assembler or linker phase, a compiler
-crash, or generation of incorrect code.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Make some fixes to alias analysis code.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Add support for @code{restrict} keyword in @command{gcc}
-front end.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Support @command{gcc} version 2.7.2.3
-(modified by @command{g77} into version 2.7.2.3.f.1),
-and remove
-support for prior versions of @command{gcc}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Incorporate GNAT's patches to the @command{gcc} back
-end into @command{g77}'s, so GNAT users do not need
-to apply GNAT's patches to build both GNAT and @command{g77}
-from the same source tree.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Modify @command{make} rules and related code so that
-generation of Info documentation doesn't require
-compilation using @command{gcc}.
-Now, any ANSI C compiler should be adequate to
-produce the @command{g77} documentation (in particular,
-the tables of intrinsics) from scratch.
-@end ifclear
-
-@item
-Add @code{INT2} and @code{INT8} intrinsics.
-
-@item
-Add @code{CPU_TIME} intrinsic.
-
-@item
-Add @code{ALARM} intrinsic.
-
-@item
-@code{CTIME} intrinsic now accepts any @code{INTEGER}
-argument, not just @code{INTEGER(KIND=2)}.
-
-@ifclear USERVISONLY
-@item
-Warn when explicit type declaration disagrees with
-the type of an intrinsic invocation.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Support @samp{*f771} entry in @command{gcc} @file{specs} file.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix typo in @command{make} rule @command{g77-cross}, used only for
-cross-compiling.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @code{libf2c} build procedure to re-archive library
-if previous attempt to archive was interrupted.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Change @command{gcc} to unroll loops only during the last
-invocation (of as many as two invocations) of loop
-optimization.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve handling of @option{-fno-f2c} so that code that
-attempts to pass an intrinsic as an actual argument,
-such as @samp{CALL FOO(ABS)}, is rejected due to the fact
-that the run-time-library routine is, effectively,
-compiled with @option{-ff2c} in effect.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} driver to recognize @option{-fsyntax-only}
-as an option that inhibits linking, just like @option{-c} or
-@option{-S}, and to recognize and properly handle the
-@option{-nostdlib}, @option{-M}, @option{-MM}, @option{-nodefaultlibs},
-and @option{-Xlinker} options.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1997-08-16.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Modify @code{libf2c} to consistently and clearly diagnose
-recursive I/O (at run time).
-@end ifclear
-
-@item
-@command{g77} driver now prints version information (such as produced
-by @kbd{g77 -v}) to @code{stderr} instead of @code{stdout}.
-
-@item
-The @samp{.r} suffix now designates a Ratfor source file,
-to be preprocessed via the @command{ratfor} command, available
-separately.
-
-@ifclear USERVISONLY
-@item
-Fix some aspects of how @command{gcc} determines what kind of
-system is being configured and what kinds are supported.
-For example, GNU Linux/Alpha ELF systems now are directly
-supported.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve diagnostics.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve documentation and indexing.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Include all pertinent files for @code{libf2c} that come
-from @code{netlib.bell-labs.com}; give any such files
-that aren't quite accurate in @command{g77}'s version of
-@code{libf2c} the suffix @samp{.netlib}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Reserve @code{INTEGER(KIND=0)} for future use.
-@end ifclear
-@end itemize
-
-@c 1997-02-28: 0.5.20 released.
-@heading In 0.5.20:
-@itemize @bullet
-@item
-The @option{-fno-typeless-boz} option is now the default.
-
-This option specifies that non-decimal-radix
-constants using the prefixed-radix form (such as @samp{Z'1234'})
-are to be interpreted as @code{INTEGER(KIND=1)} constants.
-Specify @option{-ftypeless-boz} to cause such
-constants to be interpreted as typeless.
-
-(Version 0.5.19 introduced @option{-fno-typeless-boz} and
-its inverse.)
-
-@ifset DOC-G77
-@xref{Fortran Dialect Options,,Options Controlling Fortran Dialect},
-for information on the @option{-ftypeless-boz} option.
-@end ifset
-
-@item
-Options @option{-ff90-intrinsics-enable} and
-@option{-fvxt-intrinsics-enable} now are the
-defaults.
-
-Some programs might use names that clash with
-intrinsic names defined (and now enabled) by these
-options or by the new @code{libU77} intrinsics.
-Users of such programs might need to compile them
-differently (using, for example, @option{-ff90-intrinsics-disable})
-or, better yet, insert appropriate @code{EXTERNAL}
-statements specifying that these names are not intended
-to be names of intrinsics.
-
-@item
-The @code{ALWAYS_FLUSH} macro is no longer defined when
-building @code{libf2c}, which should result in improved
-I/O performance, especially over NFS.
-
-@emph{Note:} If you have code that depends on the behavior
-of @code{libf2c} when built with @code{ALWAYS_FLUSH} defined,
-you will have to modify @code{libf2c} accordingly before
-building it from this and future versions of @command{g77}.
-
-@ifset DOC-G77
-@xref{Output Assumed To Flush}, for more information.
-@end ifset
-
-@item
-Dave Love's implementation of @code{libU77} has been
-added to the version of @code{libf2c} distributed with
-and built as part of @command{g77}.
-@command{g77} now knows about the routines in this library
-as intrinsics.
-
-@item
-New option @option{-fvxt} specifies that the
-source file is written in VXT Fortran, instead of GNU Fortran.
-
-@ifset DOC-G77
-@xref{VXT Fortran}, for more information on the constructs
-recognized when the @option{-fvxt} option is specified.
-@end ifset
-
-@item
-The @option{-fvxt-not-f90} option has been deleted,
-along with its inverse, @option{-ff90-not-vxt}.
-
-If you used one of these deleted options, you should
-re-read the pertinent documentation to determine which
-options, if any, are appropriate for compiling your
-code with this version of @command{g77}.
-
-@ifset DOC-G77
-@xref{Other Dialects}, for more information.
-@end ifset
-
-@item
-The @option{-fugly} option now issues a warning, as it
-likely will be removed in a future version.
-
-(Enabling all the @option{-fugly-*} options is unlikely
-to be feasible, or sensible, in the future,
-so users should learn to specify only those
-@option{-fugly-*} options they really need for a
-particular source file.)
-
-@item
-The @option{-fugly-assumed} option, introduced in
-version 0.5.19, has been changed to
-better accommodate old and new code.
-
-@ifset DOC-G77
-@xref{Ugly Assumed-Size Arrays}, for more information.
-@end ifset
-
-@ifclear USERVISONLY
-@item
-Make a number of fixes to the @command{g77} front end and
-the @command{gcc} back end to better support Alpha (AXP)
-machines.
-This includes providing at least one bug-fix to the
-@command{gcc} back end for Alphas.
-@end ifclear
-
-@item
-Related to supporting Alpha (AXP) machines, the @code{LOC()}
-intrinsic and @code{%LOC()} construct now return
-values of @code{INTEGER(KIND=0)} type,
-as defined by the GNU Fortran language.
-
-This type is wide enough
-(holds the same number of bits)
-as the character-pointer type on the machine.
-
-On most machines, this won't make a difference,
-whereas, on Alphas and other systems with 64-bit pointers,
-the @code{INTEGER(KIND=0)} type is equivalent to @code{INTEGER(KIND=2)}
-(often referred to as @code{INTEGER*8})
-instead of the more common @code{INTEGER(KIND=1)}
-(often referred to as @code{INTEGER*4}).
-
-@item
-Emulate @code{COMPLEX} arithmetic in the @command{g77} front
-end, to avoid bugs in @code{complex} support in the
-@command{gcc} back end.
-New option @option{-fno-emulate-complex}
-causes @command{g77} to revert the 0.5.19 behavior.
-
-@ifclear USERVISONLY
-@item
-Fix bug whereby @samp{REAL A(1)}, for example, caused
-a compiler crash if @option{-fugly-assumed} was in effect
-and @var{A} was a local (automatic) array.
-That case is no longer affected by the new
-handling of @option{-fugly-assumed}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix @command{g77} command driver so that @samp{g77 -o foo.f}
-no longer deletes @file{foo.f} before issuing other
-diagnostics, and so the @option{-x} option is properly
-handled.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Enable inlining of subroutines and functions by the @command{gcc}
-back end.
-This works as it does for @command{gcc} itself---program units
-may be inlined for invocations that follow them in the same
-program unit, as long as the appropriate compile-time
-options are specified.
-@end ifclear
-
-@item
-Dummy arguments are no longer assumed to potentially alias
-(overlap)
-other dummy arguments or @code{COMMON} areas when any of
-these are defined (assigned to) by Fortran code.
-
-This can result in faster and/or smaller programs when
-compiling with optimization enabled, though on some
-systems this effect is observed only when @option{-fforce-addr}
-also is specified.
-
-New options @option{-falias-check}, @option{-fargument-alias},
-@option{-fargument-noalias},
-and @option{-fno-argument-noalias-global} control the
-way @command{g77} handles potential aliasing.
-
-@ifset DOC-G77
-@xref{Aliasing Assumed To Work}, for detailed information on why the
-new defaults might result in some programs no longer working the way they
-did when compiled by previous versions of @command{g77}.
-@end ifset
-
-@ifclear USERVISONLY
-@item
-The @code{CONJG()} and @code{DCONJG()} intrinsics now
-are compiled in-line.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-The bug-fix for 0.5.19.1 has been re-done.
-The @command{g77} compiler has been changed back to
-assume @code{libf2c} has no aliasing problems in
-its implementations of the @code{COMPLEX} (and
-@code{DOUBLE COMPLEX}) intrinsics.
-The @code{libf2c} has been changed to have no such
-problems.
-
-As a result, 0.5.20 is expected to offer improved performance
-over 0.5.19.1, perhaps as good as 0.5.19 in most
-or all cases, due to this change alone.
-
-@emph{Note:} This change requires version 0.5.20 of
-@code{libf2c}, at least, when linking code produced
-by any versions of @command{g77} other than 0.5.19.1.
-Use @samp{g77 -v} to determine the version numbers
-of the @code{libF77}, @code{libI77}, and @code{libU77}
-components of the @code{libf2c} library.
-(If these version numbers are not printed---in
-particular, if the linker complains about unresolved
-references to names like @samp{g77__fvers__}---that
-strongly suggests your installation has an obsolete
-version of @code{libf2c}.)
-@end ifclear
-
-@item
-New option @option{-fugly-assign} specifies that the
-same memory locations are to be used to hold the
-values assigned by both statements @samp{I = 3} and
-@samp{ASSIGN 10 TO I}, for example.
-(Normally, @command{g77} uses a separate memory location
-to hold assigned statement labels.)
-
-@ifset DOC-G77
-@xref{Ugly Assigned Labels}, for more information.
-@end ifset
-
-@item
-@code{FORMAT} and @code{ENTRY} statements now are allowed to
-precede @code{IMPLICIT NONE} statements.
-
-@ifclear USERVISONLY
-@item
-Produce diagnostic for unsupported @code{SELECT CASE} on
-@code{CHARACTER} type, instead of crashing, at compile time.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Fix crashes involving diagnosed or invalid code.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Change approach to building @code{libf2c} archive
-(@file{libf2c.a}) so that members are added to it
-only when truly necessary, so the user that installs
-an already-built @command{g77} doesn't need to have write
-access to the build tree (whereas the user doing the
-build might not have access to install new software
-on the system).
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Support @command{gcc} version 2.7.2.2
-(modified by @command{g77} into version 2.7.2.2.f.2),
-and remove
-support for prior versions of @command{gcc}.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Upgrade to @code{libf2c} as of 1997-02-08, and
-fix up some of the build procedures.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improve general build procedures for @command{g77},
-fixing minor bugs (such as deletion of any file
-named @file{f771} in the parent directory of @code{gcc/}).
-@end ifclear
-
-@item
-Enable full support of @code{INTEGER(KIND=2)}
-(often referred to as @code{INTEGER*8})
-available in
-@code{libf2c} and @file{f2c.h} so that @command{f2c} users
-may make full use of its features via the @command{g77}
-version of @file{f2c.h} and the @code{INTEGER(KIND=2)}
-support routines in the @command{g77} version of @code{libf2c}.
-
-@item
-Improve @command{g77} driver and @code{libf2c} so that @samp{g77 -v}
-yields version information on the library.
-
-@item
-The @code{SNGL} and @code{FLOAT} intrinsics now are
-specific intrinsics, instead of synonyms for the
-generic intrinsic @code{REAL}.
-
-@item
-New intrinsics have been added.
-These are @code{REALPART}, @code{IMAGPART},
-@code{COMPLEX},
-@code{LONG}, and @code{SHORT}.
-
-@item
-A new group of intrinsics, @code{gnu}, has been added
-to contain the new @code{REALPART}, @code{IMAGPART},
-and @code{COMPLEX} intrinsics.
-An old group, @code{dcp}, has been removed.
-
-@item
-Complain about industry-wide ambiguous references
-@samp{REAL(@var{expr})} and @samp{AIMAG(@var{expr})},
-where @var{expr} is @code{DOUBLE COMPLEX} (or any
-complex type other than @code{COMPLEX}), unless
-@option{-ff90} option specifies Fortran 90 interpretation
-or new @option{-fugly-complex} option, in conjunction with
-@option{-fnot-f90}, specifies @command{f2c} interpretation.
-
-@ifclear USERVISONLY
-@item
-Make improvements to diagnostics.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Speed up compiler a bit.
-@end ifclear
-
-@ifclear USERVISONLY
-@item
-Improvements to documentation and indexing, including
-a new chapter containing information on one, later
-more, diagnostics that users are directed to pull
-up automatically via a message in the diagnostic itself.
-
-(Hence the menu item @code{M} for the node
-@code{Diagnostics} in the top-level menu of
-the Info documentation.)
-@end ifclear
-@end itemize
-
-@ifclear DOC-OLDNEWS
-@heading In previous versions:
-
-Information on previous versions is archived
-in @file{@value{path-g77}/news.texi}
-following the test of the @code{DOC-OLDNEWS} macro.
-@end ifclear
-
-@ifset DOC-OLDNEWS
-@c 1997-02-01: 0.5.19.1 released.
-@heading In 0.5.19.1:
-@itemize @bullet
-@item
-Code-generation bugs afflicting operations on complex
-data have been fixed.
-
-These bugs occurred when assigning the result of an
-operation to a complex variable (or array element)
-that also served as an input to that operation.
-
-The operations affected by this bug were: @code{CONJG()},
-@code{DCONJG()}, @code{CCOS()}, @code{CDCOS()},
-@code{CLOG()}, @code{CDLOG()}, @code{CSIN()}, @code{CDSIN()},
-@code{CSQRT()}, @code{CDSQRT()}, complex division, and
-raising a @code{DOUBLE COMPLEX} operand to an @code{INTEGER}
-power.
-(The related generic and @samp{Z}-prefixed intrinsics,
-such as @code{ZSIN()}, also were affected.)
-
-For example, @samp{C = CSQRT(C)}, @samp{Z = Z/C}, and @samp{Z = Z**I}
-(where @samp{C} is @code{COMPLEX} and @samp{Z} is
-@code{DOUBLE COMPLEX}) have been fixed.
-@end itemize
-
-@c 1996-12-07: 0.5.19 released.
-@heading In 0.5.19:
-@itemize @bullet
-@item
-Fix @code{FORMAT} statement parsing so negative values for
-specifiers such as @code{P} (e.g. @samp{FORMAT(-1PF8.1)})
-are correctly processed as negative.
-
-@item
-Fix @code{SIGNAL} intrinsic so it once again accepts a
-procedure as its second argument.
-
-@item
-A temporary kludge option provides bare-bones information on
-@code{COMMON} and @code{EQUIVALENCE} members at debug time.
-
-@item
-New @option{-fonetrip} option specifies FORTRAN-66-style
-one-trip @code{DO} loops.
-
-@item
-New @option{-fno-silent} option causes names of program units
-to be printed as they are compiled, in a fashion similar to
-UNIX @command{f77} and @command{f2c}.
-
-@item
-New @option{-fugly-assumed} option specifies that arrays
-dimensioned via @samp{DIMENSION X(1)}, for example, are to be
-treated as assumed-size.
-
-@item
-New @option{-fno-typeless-boz} option specifies that non-decimal-radix
-constants using the prefixed-radix form (such as @samp{Z'1234'})
-are to be interpreted as @code{INTEGER} constants.
-
-@item
-New @option{-ff66} option is a ``shorthand'' option that specifies
-behaviors considered appropriate for FORTRAN 66 programs.
-
-@item
-New @option{-ff77} option is a ``shorthand'' option that specifies
-behaviors considered appropriate for UNIX @command{f77} programs.
-
-@item
-New @option{-fugly-comma} and @option{-fugly-logint} options provided
-to perform some of what @option{-fugly} used to do.
-@option{-fugly} and @option{-fno-ugly} are now ``shorthand'' options,
-in that they do nothing more than enable (or disable) other
-@option{-fugly-*} options.
-
-@item
-Fix parsing of assignment statements involving targets that
-are substrings of elements of @code{CHARACTER} arrays having
-names such as @samp{READ}, @samp{WRITE}, @samp{GOTO}, and
-@samp{REALFUNCTIONFOO}.
-
-@item
-Fix crashes involving diagnosed code.
-
-@item
-Fix handling of local @code{EQUIVALENCE} areas so certain cases
-of valid Fortran programs are not misdiagnosed as improperly
-extending the area backwards.
-
-@item
-Support @command{gcc} version 2.7.2.1.
-
-@item
-Upgrade to @code{libf2c} as of 1996-09-26, and
-fix up some of the build procedures.
-
-@item
-Change code generation for list-directed I/O so it allows
-for new versions of @code{libf2c} that might return nonzero
-status codes for some operations previously assumed to always
-return zero.
-
-This change not only affects how @code{IOSTAT=} variables
-are set by list-directed I/O, it also affects whether
-@code{END=} and @code{ERR=} labels are reached by these
-operations.
-
-@item
-Add intrinsic support for new @code{FTELL} and @code{FSEEK}
-procedures in @code{libf2c}.
-
-@item
-Modify @code{fseek_()} in @code{libf2c} to be more portable
-(though, in practice, there might be no systems where this
-matters) and to catch invalid @code{whence} arguments.
-
-@item
-Some useless warnings from the @option{-Wunused} option have
-been eliminated.
-
-@item
-Fix a problem building the @file{f771} executable
-on AIX systems by linking with the @option{-bbigtoc} option.
-
-@item
-Abort configuration if @command{gcc} has not been patched
-using the patch file provided in the @file{gcc/f/gbe/}
-subdirectory.
-
-@item
-Add options @option{--help} and @option{--version} to the
-@command{g77} command, to conform to GNU coding guidelines.
-Also add printing of @command{g77} version number when
-the @option{--verbose} (@option{-v}) option is used.
-
-@item
-Change internally generated name for local @code{EQUIVALENCE}
-areas to one based on the alphabetically sorted first name
-in the list of names for entities placed at the beginning
-of the areas.
-
-@item
-Improvements to documentation and indexing.
-@end itemize
-
-@c 1996-04-01: 0.5.18 released.
-@heading In 0.5.18:
-@itemize @bullet
-@item
-Add some rudimentary support for @code{INTEGER*1},
-@code{INTEGER*2}, @code{INTEGER*8},
-and their @code{LOGICAL} equivalents.
-(This support works on most, maybe all, @command{gcc} targets.)
-
-Thanks to Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
-for providing the patch for this!
-
-Among the missing elements from the support for these
-features are full intrinsic support and constants.
-
-@item
-Add some rudimentary support for the @code{BYTE} and
-@code{WORD} type-declaration statements.
-@code{BYTE} corresponds to @code{INTEGER*1},
-while @code{WORD} corresponds to @code{INTEGER*2}.
-
-Thanks to Scott Snyder (@email{snyder@@d0sgif.fnal.gov})
-for providing the patch for this!
-
-@item
-The compiler code handling intrinsics has been largely
-rewritten to accommodate the new types.
-No new intrinsics or arguments for existing
-intrinsics have been added, so there is, at this
-point, no intrinsic to convert to @code{INTEGER*8},
-for example.
-
-@item
-Support automatic arrays in procedures.
-
-@item
-Reduce space/time requirements for handling large
-@emph{sparsely} initialized aggregate arrays.
-This improvement applies to only a subset of
-the general problem to be addressed in 0.6.
-
-@item
-Treat initial values of zero as if they weren't
-specified (in DATA and type-declaration statements).
-The initial values will be set to zero anyway, but the amount
-of compile time processing them will be reduced,
-in some cases significantly (though, again, this
-is only a subset of the general problem to be
-addressed in 0.6).
-
-A new option, @option{-fzeros}, is introduced to
-enable the traditional treatment of zeros as any
-other value.
-
-@item
-With @option{-ff90} in force, @command{g77} incorrectly
-interpreted @samp{REAL(Z)} as returning a @code{REAL}
-result, instead of as a @code{DOUBLE PRECISION}
-result.
-(Here, @samp{Z} is @code{DOUBLE COMPLEX}.)
-
-With @option{-fno-f90} in force, the interpretation remains
-unchanged, since this appears to be how at least some
-F77 code using the @code{DOUBLE COMPLEX} extension expected
-it to work.
-
-Essentially, @samp{REAL(Z)} in F90 is the same as
-@samp{DBLE(Z)}, while in extended F77, it appears to
-be the same as @samp{REAL(REAL(Z))}.
-
-@item
-An expression involving exponentiation, where both operands
-were type @code{INTEGER} and the right-hand operand
-was negative, was erroneously evaluated.
-
-@item
-Fix bugs involving @code{DATA} implied-@code{DO} constructs
-(these involved an errant diagnostic and a crash, both on good
-code, one involving subsequent statement-function definition).
-
-@item
-Close @code{INCLUDE} files after processing them, so compiling source
-files with lots of @code{INCLUDE} statements does not result in
-being unable to open @code{INCLUDE} files after all the available
-file descriptors are used up.
-
-@item
-Speed up compiling, especially of larger programs, and perhaps
-slightly reduce memory utilization while compiling (this is
-@emph{not} the improvement planned for 0.6 involving large aggregate
-areas)---these improvements result from simply turning
-off some low-level code to do self-checking that hasn't been
-triggered in a long time.
-
-@item
-Introduce three new options that
-implement optimizations in the @command{gcc} back end (GBE).
-These options are @option{-fmove-all-movables}, @option{-freduce-all-givs},
-and @option{-frerun-loop-opt}, which are enabled, by default,
-for Fortran compilations.
-These optimizations are intended to help toon Fortran programs.
-
-@item
-Patch the GBE to do a better job optimizing certain
-kinds of references to array elements.
-
-@item
-Due to patches to the GBE, the version number of @command{gcc}
-also is patched to make it easier to manage installations,
-especially useful if it turns out a @command{g77} change to the
-GBE has a bug.
-
-The @command{g77}-modified version number is the @command{gcc}
-version number with the string @samp{.f.@var{n}} appended,
-where @samp{f} identifies the version as enhanced for
-Fortran, and @var{n} is @samp{1} for the first Fortran
-patch for that version of @command{gcc}, @samp{2} for the
-second, and so on.
-
-So, this introduces version 2.7.2.f.1 of @command{gcc}.
-
-@item
-Make several improvements and fixes to diagnostics, including
-the removal of two that were inappropriate or inadequate.
-
-@item
-Warning about two successive arithmetic operators, produced
-by @option{-Wsurprising}, now produced @emph{only} when both
-operators are, indeed, arithmetic (not relational/boolean).
-
-@item
-@option{-Wsurprising} now warns about the remaining cases
-of using non-integral variables for implied-@code{DO}
-loops, instead of these being rejected unless @option{-fpedantic}
-or @option{-fugly} specified.
-
-@item
-Allow @code{SAVE} of a local variable or array, even after
-it has been given an initial value via @code{DATA}, for example.
-
-@item
-Introduce an Info version of @command{g77} documentation, which
-supersedes @file{gcc/f/CREDITS}, @file{gcc/f/DOC}, and
-@file{gcc/f/PROJECTS}.
-These files will be removed in a future release.
-The files @file{gcc/f/BUGS}, @file{gcc/f/INSTALL}, and
-@file{gcc/f/NEWS} now are automatically built from
-the texinfo source when distributions are made.
-
-This effort was inspired by a first pass at translating
-@file{g77-0.5.16/f/DOC} that was contributed to Craig by
-David Ronis (@email{ronis@@onsager.chem.mcgill.ca}).
-
-@item
-New @option{-fno-second-underscore} option to specify
-that, when @option{-funderscoring} is in effect, a second
-underscore is not to be appended to Fortran names already
-containing an underscore.
-
-@item
-Change the way iterative @code{DO} loops work to follow
-the F90 standard.
-In particular, calculation of the iteration count is
-still done by converting the start, end, and increment
-parameters to the type of the @code{DO} variable, but
-the result of the calculation is always converted to
-the default @code{INTEGER} type.
-
-(This should have no effect on existing code compiled
-by @command{g77}, but code written to assume that use
-of a @emph{wider} type for the @code{DO} variable
-will result in an iteration count being fully calculated
-using that wider type (wider
-than default @code{INTEGER}) must be rewritten.)
-
-@item
-Support @command{gcc} version 2.7.2.
-
-@item
-Upgrade to @code{libf2c} as of 1996-03-23, and
-fix up some of the build procedures.
-
-Note that the email addresses related to @command{f2c}
-have changed---the distribution site now is
-named @code{netlib.bell-labs.com}, and the
-maintainer's new address is @email{dmg@@bell-labs.com}.
-@end itemize
-
-@c 1995-11-18: 0.5.17 released.
-@heading In 0.5.17:
-@itemize @bullet
-@item
-@strong{Fix serious bug} in @samp{g77 -v} command that can cause removal of a
-system's @file{/dev/null} special file if run by user @code{root}.
-
-@strong{All users} of version 0.5.16 should ensure that
-they have not removed @file{/dev/null} or replaced it with an ordinary
-file (e.g. by comparing the output of @samp{ls -l /dev/null} with
-@samp{ls -l /dev/zero}.
-If the output isn't basically the
-same, contact your system
-administrator about restoring @file{/dev/null} to its proper status).
-
-This bug is particularly insidious because removing @file{/dev/null} as
-a special file can go undetected for quite a while, aside from
-various applications and programs exhibiting sudden, strange
-behaviors.
-
-I sincerely apologize for not realizing the
-implications of the fact that when @samp{g77 -v} runs the @command{ld} command
-with @samp{-o /dev/null} that @command{ld} tries to @emph{remove} the executable
-it is supposed to build (especially if it reports unresolved
-references, which it should in this case)!
-
-@item
-Fix crash on @samp{CHARACTER*(*) FOO} in a main or block data program unit.
-
-@item
-Fix crash that can occur when diagnostics given outside of any
-program unit (such as when input file contains @samp{@@foo}).
-
-@item
-Fix crashes, infinite loops (hangs), and such involving diagnosed code.
-
-@item
-Fix @code{ASSIGN}'ed variables so they can be @code{SAVE}'d or dummy arguments,
-and issue clearer error message in cases where target of @code{ASSIGN}
-or @code{ASSIGN}ed @code{GOTO}/@code{FORMAT} is too small (which should
-never happen).
-
-@item
-Make @code{libf2c} build procedures work on more systems again by
-eliminating unnecessary invocations of @samp{ld -r -x} and @command{mv}.
-
-@item
-Fix omission of @option{-funix-intrinsics-@dots{}} options in list of permitted
-options to compiler.
-
-@item
-Fix failure to always diagnose missing type declaration for
-@code{IMPLICIT NONE}.
-
-@item
-Fix compile-time performance problem (which could sometimes
-crash the compiler, cause a hang, or whatever, due to a bug
-in the back end) involving exponentiation with a large @code{INTEGER}
-constant for the right-hand operator (e.g. @samp{I**32767}).
-
-@item
-Fix build procedures so cross-compiling @command{g77} (the @command{fini}
-utility in particular) is properly built using the host compiler.
-
-@item
-Add new @option{-Wsurprising} option to warn about constructs that are
-interpreted by the Fortran standard (and @command{g77}) in ways that
-are surprising to many programmers.
-
-@item
-Add @code{ERF()} and @code{ERFC()} as generic intrinsics mapping to existing
-@code{ERF}/@code{DERF} and @code{ERFC}/@code{DERFC} specific intrinsics.
-
-@emph{Note:} You should
-specify @samp{INTRINSIC ERF,ERFC} in any code where you might use
-these as generic intrinsics, to improve likelihood of diagnostics
-(instead of subtle run-time bugs) when using a compiler that
-doesn't support these as intrinsics (e.g. @command{f2c}).
-
-@item
-Remove from @option{-fno-pedantic} the diagnostic about @code{DO}
-with non-@code{INTEGER} index variable; issue that under
-@option{-Wsurprising} instead.
-
-@item
-Clarify some diagnostics that say things like ``ignored'' when that's
-misleading.
-
-@item
-Clarify diagnostic on use of @code{.EQ.}/@code{.NE.} on @code{LOGICAL}
-operands.
-
-@item
-Minor improvements to code generation for various operations on
-@code{LOGICAL} operands.
-
-@item
-Minor improvement to code generation for some @code{DO} loops on some
-machines.
-
-@item
-Support @command{gcc} version 2.7.1.
-
-@item
-Upgrade to @code{libf2c} as of 1995-11-15.
-@end itemize
-
-@c 1995-08-30: 0.5.16 released.
-@heading In 0.5.16:
-@itemize @bullet
-@item
-Fix a code-generation bug involving complicated @code{EQUIVALENCE} statements
-not involving @code{COMMON}.
-
-@item
-Fix code-generation bugs involving invoking ``gratis'' library procedures
-in @code{libf2c} from code compiled with @option{-fno-f2c} by making these
-procedures known to @command{g77} as intrinsics (not affected by -fno-f2c).
-This is known to fix code invoking @code{ERF()}, @code{ERFC()},
-@code{DERF()}, and @code{DERFC()}.
-
-@item
-Update @code{libf2c} to include netlib patches through 1995-08-16, and
-@code{#define} @code{WANT_LEAD_0} to 1 to make @command{g77}-compiled code more
-consistent with other Fortran implementations by outputting
-leading zeros in formatted and list-directed output.
-
-@item
-Fix a code-generation bug involving adjustable dummy arrays with high
-bounds whose primaries are changed during procedure execution, and
-which might well improve code-generation performance for such arrays
-compared to @command{f2c} plus @command{gcc} (but apparently only when using
-@file{gcc-2.7.0} or later).
-
-@item
-Fix a code-generation bug involving invocation of @code{COMPLEX} and
-@code{DOUBLE COMPLEX} @code{FUNCTION}s and doing @code{COMPLEX} and
-@code{DOUBLE COMPLEX} divides, when the result
-of the invocation or divide is assigned directly to a variable
-that overlaps one or more of the arguments to the invocation or divide.
-
-@item
-Fix crash by not generating new optimal code for @samp{X**I} if @samp{I} is
-nonconstant and the expression is used to dimension a dummy
-array, since the @command{gcc} back end does not support the necessary
-mechanics (and the @command{gcc} front end rejects the equivalent
-construct, as it turns out).
-
-@item
-Fix crash on expressions like @samp{COMPLEX**INTEGER}.
-
-@item
-Fix crash on expressions like @samp{(1D0,2D0)**2}, i.e. raising a
-@code{DOUBLE COMPLEX} constant to an @code{INTEGER} constant power.
-
-@item
-Fix crashes and such involving diagnosed code.
-
-@item
-Diagnose, instead of crashing on, statement function definitions
-having duplicate dummy argument names.
-
-@item
-Fix bug causing rejection of good code involving statement function
-definitions.
-
-@item
-Fix bug resulting in debugger not knowing size of local equivalence
-area when any member of area has initial value (via @code{DATA},
-for example).
-
-@item
-Fix installation bug that prevented installation of @command{g77} driver.
-Provide for easy selection of whether to install copy of @command{g77}
-as @command{f77} to replace the broken code.
-
-@item
-Fix @command{gcc} driver (affects @command{g77} thereby) to not
-gratuitously invoke the
-@code{f771} program (e.g. when @option{-E} is specified).
-
-@item
-Fix diagnostic to point to correct source line when it immediately
-follows an @code{INCLUDE} statement.
-
-@item
-Support more compiler options in @command{gcc}/@command{g77} when
-compiling Fortran files.
-These options include @option{-p}, @option{-pg}, @option{-aux-info}, @option{-P},
-correct setting of version-number macros for preprocessing, full
-recognition of @option{-O0}, and
-automatic insertion of configuration-specific linker specs.
-
-@item
-Add new intrinsics that interface to existing routines in @code{libf2c}:
-@code{ABORT}, @code{DERF}, @code{DERFC}, @code{ERF}, @code{ERFC}, @code{EXIT},
-@code{FLUSH}, @code{GETARG}, @code{GETENV}, @code{IARGC},
-@code{SIGNAL}, and @code{SYSTEM}.
-Note that @code{ABORT}, @code{EXIT}, @code{FLUSH}, @code{SIGNAL}, and
-@code{SYSTEM} are intrinsic subroutines, not functions (since they
-have side effects), so to get the return values from @code{SIGNAL}
-and @code{SYSTEM}, append a final argument specifying an @code{INTEGER}
-variable or array element (e.g. @samp{CALL SYSTEM('rm foo',ISTAT)}).
-
-@item
-Add new intrinsic group named @code{unix} to contain the new intrinsics,
-and by default enable this new group.
-
-@item
-Move @code{LOC()} intrinsic out of the @code{vxt} group to the new
-@code{unix} group.
-
-@item
-Improve @command{g77} so that @samp{g77 -v} by itself (or with
-certain other options, including @option{-B}, @option{-b}, @option{-i},
-@option{-nostdlib}, and @option{-V}) reports lots more useful
-version info, and so that long-form options @command{gcc} accepts are
-understood by @command{g77} as well (even in truncated, unambiguous forms).
-
-@item
-Add new @command{g77} option @option{--driver=name} to specify driver when
-default, @command{gcc}, isn't appropriate.
-
-@item
-Add support for @samp{#} directives (as output by the preprocessor) in the
-compiler, and enable generation of those directives by the
-preprocessor (when compiling @samp{.F} files) so diagnostics and debugging
-info are more useful to users of the preprocessor.
-
-@item
-Produce better diagnostics, more like @command{gcc}, with info such as
-@samp{In function `foo':} and @samp{In file included from...:}.
-
-@item
-Support @command{gcc}'s @option{-fident} and @option{-fno-ident} options.
-
-@item
-When @option{-Wunused} in effect, don't warn about local variables used as
-statement-function dummy arguments or @code{DATA} implied-@code{DO} iteration
-variables, even though, strictly speaking, these are not uses
-of the variables themselves.
-
-@item
-When @samp{-W -Wunused} in effect, don't warn about unused dummy arguments
-at all, since there's no way to turn this off for individual
-cases (@command{g77} might someday start warning about these)---applies
-to @command{gcc} versions 2.7.0 and later, since earlier versions didn't
-warn about unused dummy arguments.
-
-@item
-New option @option{-fno-underscoring} that inhibits transformation of names
-(by appending one or two underscores) so users may experiment
-with implications of such an environment.
-
-@item
-Minor improvement to @file{gcc/f/info} module to make it easier to build
-@command{g77} using the native (non-@command{gcc}) compiler on certain machines
-(but definitely not all machines nor all non-@command{gcc} compilers).
-Please
-do not report bugs showing problems compilers have with
-macros defined in @file{gcc/f/target.h} and used in places like
-@file{gcc/f/expr.c}.
-
-@item
-Add warning to be printed for each invocation of the compiler
-if the target machine @code{INTEGER}, @code{REAL}, or @code{LOGICAL} size
-is not 32 bits,
-since @command{g77} is known to not work well for such cases.
-
-@item
-Lots of new documentation (though work is still needed to put it into
-canonical GNU format).
-
-@item
-Build @code{libf2c} with @option{-g0}, not @option{-g2}, in effect
-(by default), to produce
-smaller library without lots of debugging clutter.
-@end itemize
-
-@c 1995-05-19: 0.5.15 released.
-@heading In 0.5.15:
-@itemize @bullet
-@item
-Fix bad code generation involving @samp{X**I} and temporary, internal variables
-generated by @command{g77} and the back end (such as for @code{DO} loops).
-
-@item
-Fix crash given @samp{CHARACTER A;DATA A/.TRUE./}.
-
-@item
-Replace crash with diagnostic given @samp{CHARACTER A;DATA A/1.0/}.
-
-@item
-Fix crash or other erratic behavior when null character constant
-(@samp{''}) is encountered.
-
-@item
-Fix crash or other erratic behavior involving diagnosed code.
-
-@item
-Fix code generation for external functions returning type @code{REAL} when
-the @option{-ff2c} option is in force (which it is by default) so that
-@command{f2c} compatibility is indeed provided.
-
-@item
-Disallow @samp{COMMON I(10)} if @samp{I} has previously been specified
-with an array declarator.
-
-@item
-New @option{-ffixed-line-length-@var{n}} option, where @var{n} is the
-maximum length
-of a typical fixed-form line, defaulting to 72 columns, such
-that characters beyond column @var{n} are ignored, or @var{n} is @samp{none},
-meaning no characters are ignored.
-does not affect lines
-with @samp{&} in column 1, which are always processed as if
-@option{-ffixed-line-length-none} was in effect.
-
-@item
-No longer generate better code for some kinds of array references,
-as @command{gcc} back end is to be fixed to do this even better, and it
-turned out to slow down some code in some cases after all.
-
-@item
-In @code{COMMON} and @code{EQUIVALENCE} areas with any members given initial
-values (e.g. via @code{DATA}), uninitialized members now always
-initialized to binary zeros (though this is not required by
-the standard, and might not be done in future versions
-of @command{g77}).
-Previously, in some @code{COMMON}/@code{EQUIVALENCE} areas
-(essentially those with members of more than one type), the
-uninitialized members were initialized to spaces, to
-cater to @code{CHARACTER} types, but it seems no existing code expects
-that, while much existing code expects binary zeros.
-@end itemize
-
-@heading In 0.5.14:
-@itemize @bullet
-@item
-Don't emit bad code when low bound of adjustable array is nonconstant
-and thus might vary as an expression at run time.
-
-@item
-Emit correct code for calculation of number of trips in @code{DO} loops
-for cases
-where the loop should not execute at all.
-(This bug affected cases
-where the difference between the begin and end values was less
-than the step count, though probably not for floating-point cases.)
-
-@item
-Fix crash when extra parentheses surround item in
-@code{DATA} implied-@code{DO} list.
-
-@item
-Fix crash over minor internal inconsistencies in handling diagnostics,
-just substitute dummy strings where necessary.
-
-@item
-Fix crash on some systems when compiling call to @code{MVBITS()} intrinsic.
-
-@item
-Fix crash on array assignment @samp{TYPE@var{ddd}(@dots{})=@dots{}}, where @var{ddd}
-is a string of one or more digits.
-
-@item
-Fix crash on @code{DCMPLX()} with a single @code{INTEGER} argument.
-
-@item
-Fix various crashes involving code with diagnosed errors.
-
-@item
-Support @option{-I} option for @code{INCLUDE} statement, plus @command{gcc}'s
-@file{header.gcc} facility for handling systems like MS-DOS.
-
-@item
-Allow @code{INCLUDE} statement to be continued across multiple lines,
-even allow it to coexist with other statements on the same line.
-
-@item
-Incorporate Bellcore fixes to @code{libf2c} through 1995-03-15---this
-fixes a bug involving infinite loops reading EOF with empty list-directed
-I/O list.
-
-@item
-Remove all the @command{g77}-specific auto-configuration scripts, code,
-and so on,
-except for temporary substitutes for bsearch() and strtoul(), as
-too many configure/build problems were reported in these areas.
-People will have to fix their systems' problems themselves, or at
-least somewhere other than @command{g77}, which expects a working ANSI C
-environment (and, for now, a GNU C compiler to compile @command{g77} itself).
-
-@item
-Complain if initialized common redeclared as larger in subsequent program
-unit.
-
-@item
-Warn if blank common initialized, since its size can vary and hence
-related warnings that might be helpful won't be seen.
-
-@item
-New @option{-fbackslash} option, on by default, that causes @samp{\}
-within @code{CHARACTER}
-and Hollerith constants to be interpreted a la GNU C.
-Note that
-this behavior is somewhat different from @command{f2c}'s, which supports only
-a limited subset of backslash (escape) sequences.
-
-@item
-Make @option{-fugly-args} the default.
-
-@item
-New @option{-fugly-init} option, on by default, that allows typeless/Hollerith
-to be specified as initial values for variables or named constants
-(@code{PARAMETER}), and also allows character<->numeric conversion in
-those contexts---turn off via @option{-fno-ugly-init}.
-
-@item
-New @option{-finit-local-zero} option to initialize
-local variables to binary zeros.
-This does not affect whether they are @code{SAVE}d, i.e. made
-automatic or static.
-
-@item
-New @option{-Wimplicit} option to warn about implicitly typed variables, arrays,
-and functions.
-(Basically causes all program units to default to @code{IMPLICIT NONE}.)
-
-@item
-@option{-Wall} now implies @option{-Wuninitialized} as with @command{gcc}
-(i.e. unless @option{-O} not specified, since @option{-Wuninitialized}
-requires @option{-O}), and implies @option{-Wunused} as well.
-
-@item
-@option{-Wunused} no longer gives spurious messages for unused
-@code{EXTERNAL} names (since they are assumed to refer to block data
-program units, to make use of libraries more reliable).
-
-@item
-Support @code{%LOC()} and @code{LOC()} of character arguments.
-
-@item
-Support null (zero-length) character constants and expressions.
-
-@item
-Support @command{f2c}'s @code{IMAG()} generic intrinsic.
-
-@item
-Support @code{ICHAR()}, @code{IACHAR()}, and @code{LEN()} of
-character expressions that are valid in assignments but
-not normally as actual arguments.
-
-@item
-Support @command{f2c}-style @samp{&} in column 1 to mean continuation line.
-
-@item
-Allow @code{NAMELIST}, @code{EXTERNAL}, @code{INTRINSIC}, and @code{VOLATILE}
-in @code{BLOCK DATA}, even though these are not allowed by the standard.
-
-@item
-Allow @code{RETURN} in main program unit.
-
-@item
-Changes to Hollerith-constant support to obey Appendix C of the
-standard:
-
-@itemize @minus
-@item
-Now padded on the right with zeros, not spaces.
-
-@item
-Hollerith ``format specifications'' in the form of arrays of
-non-character allowed.
-
-@item
-Warnings issued when non-space truncation occurs when converting
-to another type.
-
-@item
-When specified as actual argument, now passed
-by reference to @code{INTEGER} (padded on right with spaces if constant
-too small, otherwise fully intact if constant wider the @code{INTEGER}
-type) instead of by value.
-@end itemize
-
-@strong{Warning:} @command{f2c} differs on the
-interpretation of @samp{CALL FOO(1HX)}, which it treats exactly the
-same as @samp{CALL FOO('X')}, but which the standard and @command{g77} treat
-as @samp{CALL FOO(%REF('X   '))} (padded with as many spaces as necessary
-to widen to @code{INTEGER}), essentially.
-
-@item
-Changes and fixes to typeless-constant support:
-
-@itemize @minus
-@item
-Now treated as a typeless double-length @code{INTEGER} value.
-
-@item
-Warnings issued when overflow occurs.
-
-@item
-Padded on the left with zeros when converting
-to a larger type.
-
-@item
-Should be properly aligned and ordered on
-the target machine for whatever type it is turned into.
-
-@item
-When specified as actual argument, now passed as reference to
-a default @code{INTEGER} constant.
-@end itemize
-
-@item
-@code{%DESCR()} of a non-@code{CHARACTER} expression now passes a pointer to
-the expression plus a length for the expression just as if
-it were a @code{CHARACTER} expression.
-For example, @samp{CALL FOO(%DESCR(D))}, where
-@samp{D} is @code{REAL*8}, is the same as @samp{CALL FOO(D,%VAL(8)))}.
-
-@item
-Name of multi-entrypoint master function changed to incorporate
-the name of the primary entry point instead of a decimal
-value, so the name of the master function for @samp{SUBROUTINE X}
-with alternate entry points is now @samp{__g77_masterfun_x}.
-
-@item
-Remove redundant message about zero-step-count @code{DO} loops.
-
-@item
-Clean up diagnostic messages, shortening many of them.
-
-@item
-Fix typo in @command{g77} man page.
-
-@item
-Clarify implications of constant-handling bugs in @file{f/BUGS}.
-
-@item
-Generate better code for @samp{**} operator with a right-hand operand of
-type @code{INTEGER}.
-
-@item
-Generate better code for @code{SQRT()} and @code{DSQRT()},
-also when @option{-ffast-math}
-specified, enable better code generation for @code{SIN()} and @code{COS()}.
-
-@item
-Generate better code for some kinds of array references.
-
-@item
-Speed up lexing somewhat (this makes the compilation phase noticeably
-faster).
-@end itemize
-
-@end ifset
-@end ifclear
diff --git a/gcc/f/news0.texi b/gcc/f/news0.texi
deleted file mode 100644
index 21176c3..0000000
--- a/gcc/f/news0.texi
+++ /dev/null
@@ -1,9 +0,0 @@
-\input texinfo  @c -*-texinfo-*-
-@c %**start of header
-@setfilename NEWS
-@c %**end of header
-
-@c This tells news.texi that it's generating just the NEWS file.
-@set DOC-NEWS
-@include news.texi
-@bye
diff --git a/gcc/f/parse.c b/gcc/f/parse.c
deleted file mode 100644
index d822773..0000000
--- a/gcc/f/parse.c
+++ /dev/null
@@ -1,49 +0,0 @@
-/* GNU Fortran
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 "proj.h"
-#include "top.h"
-#include "com.h"
-#include "where.h"
-#include "version.h"
-#include "flags.h"
-
-extern FILE *finput;
-
-void
-ffe_parse_file (int set_yydebug ATTRIBUTE_UNUSED)
-{
-  const char *fname;
-  ffewhereFile wf;
-
-  if (ffe_is_version ())
-    fprintf (stderr, "GNU Fortran Front End version %s\n", version_string);
-
-  if (!ffe_is_pedantic ())
-    ffe_set_is_pedantic (pedantic);
-
-  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/gcc/f/proj.h b/gcc/f/proj.h
deleted file mode 100644
index 0896bdf3..0000000
--- a/gcc/f/proj.h
+++ /dev/null
@@ -1,52 +0,0 @@
-/* proj.h file for Gnu Fortran
-   Copyright (C) 1995, 1996, 2000, 2001, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-*/
-
-#ifndef GCC_F_PROJ_H
-#define GCC_F_PROJ_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."
-#endif
-
-/* Include files everyone gets.  <assert.h> is needed for assert().  */
-
-#include "assert.h"
-
-#ifndef UNUSED	/* Compile with -DUNUSED= if cc doesn't support this. */
-#define UNUSED ATTRIBUTE_UNUSED
-#endif  /* !defined (UNUSED) */
-
-#ifndef dmpout
-#define dmpout stderr
-#endif
-
-#endif /* ! GCC_F_PROJ_H */
diff --git a/gcc/f/root.texi b/gcc/f/root.texi
deleted file mode 100644
index 1956abc..0000000
--- a/gcc/f/root.texi
+++ /dev/null
@@ -1,14 +0,0 @@
-@include gcc-common.texi
-
-@set email-general gcc@@gcc.gnu.org
-@set email-help gcc-help@@gcc.gnu.org
-@set email-bugs gcc-bugs@@gcc.gnu.org or bug-gcc@@gnu.org
-@set email-patch gcc-patches@@gcc.gnu.org
-@set path-g77 gcc/gcc/f
-@set path-libf2c gcc/libf2c
-
-@set which-g77 GCC-@value{version-GCC}
-@set which-gcc GCC
-
-@set email-burley craig@@jcb-sc.com
-@set www-burley http://world.std.com/%7Eburley/
diff --git a/gcc/f/src.c b/gcc/f/src.c
deleted file mode 100644
index 54fc777..0000000
--- a/gcc/f/src.c
+++ /dev/null
@@ -1,427 +0,0 @@
-/* src.c -- Implementation File
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-
-   Description:
-      Source-file functions to handle various combinations of case sensitivity
-      and insensitivity at run time.
-
-   Modifications:
-*/
-
-#include "proj.h"
-#include "src.h"
-#include "top.h"
-
-/* This array is set up so that, given a source-mapped character, the result
-   of indexing into this array will match an upper-cased character depending
-   on the source-mapped character's case and the established ffe_case_match()
-   setting.  So the uppercase cells contain identies (e.g. ['A'] == 'A')
-   as long as uppercase matching is permitted (!FFE_caseLOWER) and the
-   lowercase cells contain uppercased identities (e.g. ['a'] == 'A') as long
-   as lowercase matching is permitted (!FFE_caseUPPER).	 Else the case
-   cells contain -1.  _init_ is for the first character of a keyword,
-   and _noninit_ is for other characters.  */
-
-char ffesrc_char_match_init_[256];
-char ffesrc_char_match_noninit_[256];
-
-/* This array is used to map input source according to the established
-   ffe_case_source() setting: for FFE_caseNONE, the array is all
-   identities; for FFE_caseUPPER, the lowercase cells contain
-   uppercased identities; and vice versa for FFE_caseLOWER.  */
-
-char ffesrc_char_source_[256];
-
-/* This array is used to map an internally generated character so that it
-   will be accepted as an initial character in a keyword.  The assumption
-   is that the incoming character is uppercase.  */
-
-char ffesrc_char_internal_init_[256];
-
-/* This array is used to determine if a particular character is valid in
-   a symbol name according to the established ffe_case_symbol() setting:
-   for FFE_caseNONE, the array is all FFEBAD; for FFE_caseUPPER, the
-   lowercase cells contain a non-FFEBAD error code (FFEBAD_SYMBOL_UPPER_CASE);
-   and vice versa for FFE_caseLOWER.  _init_ and _noninit_ distinguish
-   between initial and subsequent characters for the caseINITCAP case,
-   and their error codes are different for appropriate messages --
-   specifically, _noninit_ contains a non-FFEBAD error code for all
-   except lowercase characters for the caseINITCAP case.
-
-   See ffesrc_check_symbol_, it must be TRUE if this array is not all
-   FFEBAD.  */
-
-ffebad ffesrc_bad_symbol_init_[256];
-ffebad ffesrc_bad_symbol_noninit_[256];
-
-/* Set TRUE if any element in ffesrc_bad_symbol (with an index representing
-   a character that can also be in the text of a token passed to
-   ffename_find, strictly speaking) is not FFEBAD.  I.e., TRUE if it is
-   necessary to check token characters against the ffesrc_bad_symbol_
-   array.  */
-
-bool ffesrc_check_symbol_;
-
-/* These are set TRUE if the kind of character (upper/lower) is ok as a match
-   in the context (initial/noninitial character of keyword).  */
-
-bool ffesrc_ok_match_init_upper_;
-bool ffesrc_ok_match_init_lower_;
-bool ffesrc_ok_match_noninit_upper_;
-bool ffesrc_ok_match_noninit_lower_;
-
-/* Initialize table of alphabetic matches. */
-
-void
-ffesrc_init_1 (void)
-{
-  int i;
-
-  for (i = 0; i < 256; ++i)
-    {
-      ffesrc_char_match_init_[i] = i;
-      ffesrc_char_match_noninit_[i] = i;
-      ffesrc_char_source_[i] = i;
-      ffesrc_char_internal_init_[i] = i;
-      ffesrc_bad_symbol_init_[i] = FFEBAD;
-      ffesrc_bad_symbol_noninit_[i] = FFEBAD;
-    }
-
-  ffesrc_check_symbol_ = (ffe_case_symbol () != FFE_caseNONE);
-
-  ffesrc_ok_match_init_upper_ = (ffe_case_match () != FFE_caseLOWER);
-  ffesrc_ok_match_init_lower_ = (ffe_case_match () != FFE_caseUPPER)
-    && (ffe_case_match () != FFE_caseINITCAP);
-  ffesrc_ok_match_noninit_upper_ = (ffe_case_match () != FFE_caseLOWER)
-    && (ffe_case_match () != FFE_caseINITCAP);
-  ffesrc_ok_match_noninit_lower_ = (ffe_case_match () != FFE_caseUPPER);
-
-  /* Note that '-' is used to flag an invalid match character.	'-' is
-     somewhat arbitrary, actually.  -1 was used, but that's not wise on a
-     system with unsigned chars as default -- it'd turn into 255 or some such
-     large positive number, which would sort higher than the alphabetics and
-     thus possibly cause problems.  So '-' is picked just because it's never
-     likely to be a symbol character in Fortran and because it's "less than"
-     any alphabetic character.	EBCDIC might see things differently, I don't
-     remember it well enough, but that's just tough -- lots of other things
-     might have to change to support EBCDIC -- anyway, some other character
-     could easily be picked.  */
-
-#define FFESRC_INVALID_SYMBOL_CHAR_ '-'
-
-  if (!ffesrc_ok_match_init_upper_)
-    for (i = 'A'; i <= 'Z'; ++i)
-      ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
-
-  if (ffesrc_ok_match_init_lower_)
-    for (i = 'a'; i <= 'z'; ++i)
-      ffesrc_char_match_init_[i] = TOUPPER (i);
-  else
-    for (i = 'a'; i <= 'z'; ++i)
-      ffesrc_char_match_init_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
-
-  if (!ffesrc_ok_match_noninit_upper_)
-    for (i = 'A'; i <= 'Z'; ++i)
-      ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
-
-  if (ffesrc_ok_match_noninit_lower_)
-    for (i = 'a'; i <= 'z'; ++i)
-      ffesrc_char_match_noninit_[i] = TOUPPER (i);
-  else
-    for (i = 'a'; i <= 'z'; ++i)
-      ffesrc_char_match_noninit_[i] = FFESRC_INVALID_SYMBOL_CHAR_;
-
-  if (ffe_case_source () == FFE_caseLOWER)
-    for (i = 'A'; i <= 'Z'; ++i)
-      ffesrc_char_source_[i] = TOLOWER (i);
-  else if (ffe_case_source () == FFE_caseUPPER)
-    for (i = 'a'; i <= 'z'; ++i)
-      ffesrc_char_source_[i] = TOUPPER (i);
-
-  if (ffe_case_match () == FFE_caseLOWER)
-    for (i = 'A'; i <= 'Z'; ++i)
-      ffesrc_char_internal_init_[i] = TOLOWER (i);
-
-  switch (ffe_case_symbol ())
-    {
-    case FFE_caseLOWER:
-      for (i = 'A'; i <= 'Z'; ++i)
-	{
-	  ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_UPPER_CASE;
-	  ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_UPPER_CASE;
-	}
-      break;
-
-    case FFE_caseUPPER:
-      for (i = 'a'; i <= 'z'; ++i)
-	{
-	  ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_CASE;
-	  ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_LOWER_CASE;
-	}
-      break;
-
-    case FFE_caseINITCAP:
-      for (i = 0; i < 256; ++i)
-	ffesrc_bad_symbol_noninit_[i] = FFEBAD_SYMBOL_NOLOWER_INITCAP;
-      for (i = 'a'; i <= 'z'; ++i)
-	{
-	  ffesrc_bad_symbol_init_[i] = FFEBAD_SYMBOL_LOWER_INITCAP;
-	  ffesrc_bad_symbol_noninit_[i] = FFEBAD;
-	}
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* Compare two strings a la strcmp, the first being a source string with its
-   length passed, and the second being a constant string passed
-   in InitialCaps form.	 Also, the return value is always -1, 0, or 1. */
-
-int
-ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
-		     const char *str_ic)
-{
-  char c;
-  char d;
-
-  switch (mcase)
-    {
-    case FFE_caseNONE:
-      for (; len > 0; --len, ++var, ++str_ic)
-	{
-	  c = ffesrc_char_source (*var);	/* Transform source. */
-	  c = TOUPPER (c);			/* Upcase source. */
-	  d = TOUPPER (*str_ic);		/* Upcase InitialCaps char. */
-	  if (c != d)
-	    {
-	      if ((d != '\0') && (c < d))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      break;
-
-    case FFE_caseUPPER:
-      for (; len > 0; --len, ++var, ++str_ic)
-	{
-	  c = ffesrc_char_source (*var);	/* Transform source. */
-	  d = TOUPPER (*str_ic);	/* Transform InitialCaps char. */
-	  if (c != d)
-	    {
-	      if ((d != '\0') && (c < d))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      break;
-
-    case FFE_caseLOWER:
-      for (; len > 0; --len, ++var, ++str_ic)
-	{
-	  c = ffesrc_char_source (*var);	/* Transform source. */
-	  d = TOLOWER (*str_ic);	/* Transform InitialCaps char. */
-	  if (c != d)
-	    {
-	      if ((d != '\0') && (c < d))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      break;
-
-    case FFE_caseINITCAP:
-      for (; len > 0; --len, ++var, ++str_ic)
-	{
-	  c = ffesrc_char_source (*var);	/* Transform source. */
-	  d = *str_ic;		/* No transform of InitialCaps char. */
-	  if (c != d)
-	    {
-	      c = TOUPPER (c);
-	      d = TOUPPER (d);
-	      while ((len > 0) && (c == d))
-		{		/* Skip past equivalent (case-ins) chars. */
-		  --len, ++var, ++str_ic;
-		  if (len > 0)
-		    c = TOUPPER (*var);
-		  d = TOUPPER (*str_ic);
-		}
-	      if ((d != '\0') && (c < d))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      break;
-
-    default:
-      assert ("bad case value" == NULL);
-      return -1;
-    }
-
-  if (*str_ic == '\0')
-    return 0;
-  return -1;
-}
-
-/* Compare two strings a la strcmp, the second being a constant string passed
-   in both uppercase and lowercase form.  If not equal, the uppercase string
-   is used to determine the sign of the return value.  Also, the return
-   value is always -1, 0, or 1. */
-
-int
-ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
-		  const char *str_lc, const char *str_ic)
-{
-  int i;
-  char c;
-
-  switch (mcase)
-    {
-    case FFE_caseNONE:
-      for (; *var != '\0'; ++var, ++str_uc)
-	{
-	  c = TOUPPER (*var);	/* Upcase source. */
-	  if (c != *str_uc)
-	    {
-	      if ((*str_uc != '\0') && (c < *str_uc))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      if (*str_uc == '\0')
-	return 0;
-      return -1;
-
-    case FFE_caseUPPER:
-      i = strcmp (var, str_uc);
-      break;
-
-    case FFE_caseLOWER:
-      i = strcmp (var, str_lc);
-      break;
-
-    case FFE_caseINITCAP:
-      for (; *var != '\0'; ++var, ++str_ic, ++str_uc)
-	{
-	  if (*var != *str_ic)
-	    {
-	      c = TOUPPER (*var);
-	      while ((c != '\0') && (c == *str_uc))
-		{		/* Skip past equivalent (case-ins) chars. */
-		  ++var, ++str_uc;
-		  c = TOUPPER (*var);
-		}
-	      if ((*str_uc != '\0') && (c < *str_uc))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      if (*str_ic == '\0')
-	return 0;
-      return -1;
-
-    default:
-      assert ("bad case value" == NULL);
-      return -1;
-    }
-
-  if (i == 0)
-    return 0;
-  else if (i < 0)
-    return -1;
-  return 1;
-}
-
-/* Compare two strings a la strncmp, the second being a constant string passed
-   in uppercase, lowercase, and InitialCaps form.  If not equal, the
-   uppercase string is used to determine the sign of the return value.	*/
-
-int
-ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
-		   const char *str_lc, const char *str_ic, int len)
-{
-  int i;
-  char c;
-
-  switch (mcase)
-    {
-    case FFE_caseNONE:
-      for (; len > 0; ++var, ++str_uc, --len)
-	{
-	  c = TOUPPER (*var);	/* Upcase source. */
-	  if (c != *str_uc)
-	    {
-	      if (c < *str_uc)
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      return 0;
-
-    case FFE_caseUPPER:
-      i = strncmp (var, str_uc, len);
-      break;
-
-    case FFE_caseLOWER:
-      i = strncmp (var, str_lc, len);
-      break;
-
-    case FFE_caseINITCAP:
-      for (; len > 0; ++var, ++str_ic, ++str_uc, --len)
-	{
-	  if (*var != *str_ic)
-	    {
-	      c = TOUPPER (*var);
-	      while ((len > 0) && (c == *str_uc))
-		{		/* Skip past equivalent (case-ins) chars. */
-		  --len, ++var, ++str_uc;
-		  if (len > 0)
-		    c = TOUPPER (*var);
-		}
-	      if ((len > 0) && (c < *str_uc))
-		return -1;
-	      else
-		return 1;
-	    }
-	}
-      return 0;
-
-    default:
-      assert ("bad case value" == NULL);
-      return -1;
-    }
-
-  if (i == 0)
-    return 0;
-  else if (i < 0)
-    return -1;
-  return 1;
-}
diff --git a/gcc/f/src.h b/gcc/f/src.h
deleted file mode 100644
index ce5843e..0000000
--- a/gcc/f/src.h
+++ /dev/null
@@ -1,140 +0,0 @@
-/* src.h -- Public #include File
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      src.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_SRC_H
-#define GCC_F_SRC_H
-
-#include "bad.h"
-#include "top.h"
-
-extern char ffesrc_char_match_init_[256];
-extern char ffesrc_char_match_noninit_[256];
-extern char ffesrc_char_source_[256];
-extern char ffesrc_char_internal_init_[256];
-extern ffebad ffesrc_bad_symbol_init_[256];
-extern ffebad ffesrc_bad_symbol_noninit_[256];
-extern bool ffesrc_check_symbol_;
-extern bool ffesrc_ok_match_init_upper_;
-extern bool ffesrc_ok_match_init_lower_;
-extern bool ffesrc_ok_match_noninit_upper_;
-extern bool ffesrc_ok_match_noninit_lower_;
-
-/* These C-language-syntax modifiers could avoid the match arg if gcc's
-   extension allowing macros to generate dynamic labels was used.  They
-   could use the no_match arg (and the "caller's" label defs) if there
-   was a way to say "goto default" in a switch statement.  Oh well.
-
-   NOTE: These macro assume "case FFESRC_CASE_MATCH_[NON]INIT(...):" is used
-   to invoke them, and thus assume the "above" case does not fall through to
-   this one.  This syntax was chosen to keep indenting tools working.  */
-
-#define FFESRC_CASE_MATCH_INIT(upper, lower, match, no_match) \
- upper: if (!ffesrc_ok_match_init_upper_) goto no_match; \
-  else goto match; \
- case lower: if (!ffesrc_ok_match_init_lower_) goto no_match; \
- match
-
-#define FFESRC_CASE_MATCH_NONINIT(upper, lower, match, no_match) \
- upper: if (!ffesrc_ok_match_noninit_upper_) goto no_match; \
-  else goto match; \
- case lower: if (!ffesrc_ok_match_noninit_lower_) goto no_match; \
- match
-
-/* If character is ok in a symbol name (not including intrinsic names),
-   returns FFEBAD, else returns something else, type ffebad.  */
-
-#define ffesrc_bad_char_symbol_init(c) \
-  (ffesrc_bad_symbol_init_[(unsigned int) (c)])
-#define ffesrc_bad_char_symbol_noninit(c) \
-  (ffesrc_bad_symbol_noninit_[(unsigned int) (c)])
-
-/* Returns TRUE if character is ok in a symbol name (including
-   intrinsic names).  Doesn't care about case settings, this is
-   used just for parsing (before semantic complaints about symbol-
-   name casing and such).  One specific usage is to decide whether
-   an underscore is valid as the first or subsequent character in
-   some symbol name -- if not, an underscore is a separate token
-   (while lexing, for example).  Note that ffesrc_is_name_init
-   must return TRUE for a (not necessarily proper) subset of
-   characters for which ffelex_is_firstnamechar returns TRUE.  */
-
-#define ffesrc_is_name_init(c) \
-  ((ISALPHA ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
-#define ffesrc_is_name_noninit(c) \
-  ((ISALNUM ((c))) || (! (1 || ffe_is_90 ()) && ((c) == '_')))
-
-/* Test if source-translated character matches given alphabetic character
-   (passed in both uppercase and lowercase, to allow for custom speedup
-   of compilation in environments where compile-time options aren't needed
-   for casing).	 */
-
-#define ffesrc_char_match_init(c, up, low) \
-  (ffesrc_char_match_init_[(unsigned int) (c)] == up)
-
-#define ffesrc_char_match_noninit(c, up, low) \
-  (ffesrc_char_match_noninit_[(unsigned int) (c)] == up)
-
-/* Translate character from input-file form to source form.  */
-
-#define ffesrc_char_source(c) (ffesrc_char_source_[(unsigned int) (c)])
-
-/* Translate internal character (upper/lower) to source form in an
-   initial-character context (i.e. ffesrc_char_match_init of the result
-   will always succeed).  */
-
-#define ffesrc_char_internal_init(up, low) \
-  (ffesrc_char_internal_init_[(unsigned int) (up)])
-
-/* Returns TRUE if a name representing a symbol should be checked for
-   validity according to compile-time options.	That is, if it is possible
-   that ffesrc_bad_char_symbol(c) can return something other than FFEBAD
-   for any valid character in an ffelex NAME(S) token.	*/
-
-#define ffesrc_check_symbol() ffesrc_check_symbol_
-
-#define ffesrc_init_0()
-void ffesrc_init_1 (void);
-#define ffesrc_init_2()
-#define ffesrc_init_3()
-#define ffesrc_init_4()
-int ffesrc_strcmp_1ns2i (ffeCase mcase, const char *var, int len,
-			 const char *str_ic);
-int ffesrc_strcmp_2c (ffeCase mcase, const char *var, const char *str_uc,
-		      const char *str_lc, const char *str_ic);
-int ffesrc_strncmp_2c (ffeCase mcase, const char *var, const char *str_uc,
-		       const char *str_lc, const char *str_ic, int len);
-#define ffesrc_terminate_0()
-#define ffesrc_terminate_1()
-#define ffesrc_terminate_2()
-#define ffesrc_terminate_3()
-#define ffesrc_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_SRC_H */
diff --git a/gcc/f/st.c b/gcc/f/st.c
deleted file mode 100644
index cdfdfb5..0000000
--- a/gcc/f/st.c
+++ /dev/null
@@ -1,554 +0,0 @@
-/* st.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      The high-level input level to statement handling for the rest of the
-      FFE.  ffest_first is the first state for the lexer to invoke to start
-      a statement.  A statement normally starts with a NUMBER token (to indicate
-      a label def) followed by a NAME token (to indicate what kind of statement
-      it is), though of course the NUMBER token may be omitted.	 ffest_first
-      gathers the first NAME token and returns a state of ffest_second_,
-      where the trailing underscore means "internal to ffest" and thus outside
-      users should not depend on this.	ffest_second_ then looks at the second
-      token in conjunction with the first, decides what possible statements are
-      meant, and tries each possible statement in turn, from most likely to
-      least likely.  A successful attempt currently is recorded, and further
-      successful attempts by other possibilities raise an assertion error in
-      ffest_confirmed (this is to detect ambiguities).	A failure in an
-      attempt is signaled by calling ffest_ffebad_start; this results in the
-      next token sent by ffest_save_ (the intermediary when more than one
-      possible statement exists) being EOS to shut down processing and the next
-      possibility tried.
-
-      When all possibilities have been tried, the successful one is retried with
-      inhibition turned off (FALSE) as reported by ffest_is_inhibited().  If
-      there is no successful one, the first one is retried so the user gets to
-      see the error messages.
-
-      In the future, after syntactic bugs have been reasonably shaken out and
-      ambiguities thus detected, the first successful possibility will be
-      enabled (inhibited goes FALSE) as soon as it confirms success by calling
-      ffest_confirmed, thus retrying the possibility will not be necessary.
-
-      The only complication in all this is that expression handling is
-      happening while possibilities are inhibited.  It is up to the expression
-      handler, conceptually, to not make any changes to its knowledge base for
-      variable names and so on when inhibited that cannot be undone if
-      the current possibility fails (shuts down via ffest_ffebad_start).  In
-      fact, this business is handled not be ffeexpr, but by lower levels.
-
-      ffesta functions serve only to provide information used in syntactic
-      processing of possible statements, and thus may not make changes to the
-      knowledge base for variables and such.
-
-      ffestb functions perform the syntactic analysis for possible statements,
-      and thus again may not make changes to the knowledge base except under the
-      auspices of ffeexpr and its subordinates, changes which can be undone when
-      necessary.
-
-      ffestc functions perform the semantic analysis for the chosen statement,
-      and thus may change the knowledge base as necessary since they are invoked
-      by ffestb functions only after a given statement is confirmed and
-      enabled.	Note, however, that a few ffestc functions (identified by
-      their statement names rather than grammar numbers) indicate valid forms
-      that are, outside of any context, ambiguous, such as ELSE WHERE and
-      PRIVATE; these functions should make a quick decision as to what is
-      intended and dispatch to the appropriate specific ffestc function.
-
-      ffestd functions actually implement statements.  When called, the
-      statement is considered valid and is either an executable statement or
-      a nonexecutable statement with direct-output results.  For example, CALL,
-      GOTO, and assignment statements pass through ffestd because they are
-      executable; DATA statements pass through because they map directly to the
-      output file (or at least might so map); ENTRY statements also pass through
-      because they essentially affect code generation in an immediate way;
-      whereas INTEGER, SAVE, and SUBROUTINE statements do not go through
-      ffestd functions because they merely update the knowledge base.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "st.h"
-#include "bad.h"
-#include "lex.h"
-#include "sta.h"
-#include "stb.h"
-#include "stc.h"
-#include "std.h"
-#include "ste.h"
-#include "stp.h"
-#include "str.h"
-#include "sts.h"
-#include "stt.h"
-#include "stu.h"
-#include "stv.h"
-#include "stw.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffest_confirmed -- Confirm current possibility as only one
-
-   ffest_confirmed();
-
-   Sets the confirmation flag.	During debugging for ambiguous constructs,
-   asserts that the confirmation flag for a previous possibility has not
-   yet been set.  */
-
-void
-ffest_confirmed (void)
-{
-  ffesta_confirmed ();
-}
-
-/* ffest_eof -- End of (non-INCLUDEd) source file
-
-   ffest_eof();
-
-   Call after piping tokens through ffest_first, where the most recent
-   token sent through must be EOS.
-
-   20-Feb-91  JCB  1.1
-      Put new EOF token in ffesta_tokens[0], not NULL, because too much
-      code expects something there for error reporting and the like.  Also,
-      do basically the same things ffest_second and ffesta_zero do for
-      processing a statement (make and destroy pools, et cetera).  */
-
-void
-ffest_eof (void)
-{
-  ffesta_eof ();
-}
-
-/* ffest_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt
-
-   ffest_ffebad_here_current_stmt(0);
-
-   Outsiders can call this fn if they have no more convenient place to
-   point to (via a token or pair of ffewhere objects) and they know a
-   current, useful statement is being evaluted by ffest (i.e. they are
-   being called from ffestb, ffestc, ffestd, ... functions).  */
-
-void
-ffest_ffebad_here_current_stmt (ffebadIndex i)
-{
-  ffesta_ffebad_here_current_stmt (i);
-}
-
-/* ffest_ffebad_here_doiter -- Calls ffebad_here with ptr to DO iter var
-
-   ffesymbol s;
-   // call ffebad_start first, of course.
-   ffest_ffebad_here_doiter(0,s);
-   // call ffebad_finish afterwards, naturally.
-
-   Searches the stack of blocks backwards for a DO loop that has s
-   as its iteration variable, then calls ffebad_here with pointers to
-   that particular reference to the variable.  Crashes if the DO loop
-   can't be found.  */
-
-void
-ffest_ffebad_here_doiter (ffebadIndex i, ffesymbol s)
-{
-  ffestc_ffebad_here_doiter (i, s);
-}
-
-/* ffest_ffebad_start -- Start a possibly inhibited error report
-
-   if (ffest_ffebad_start(FFEBAD_SOME_ERROR))
-       {
-       ffebad_here, ffebad_string ...;
-       ffebad_finish();
-       }
-
-   Call if the error might indicate that ffest is evaluating the wrong
-   statement form, instead of calling ffebad_start directly.  If ffest
-   is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
-   token through as the next token (if the current one isn't already one
-   of those), and try another possible form.  Otherwise, ffebad_start is
-   called with the argument and TRUE returned.	*/
-
-bool
-ffest_ffebad_start (ffebad errnum)
-{
-  return ffesta_ffebad_start (errnum);
-}
-
-/* ffest_first -- Parse the first token in a statement
-
-   return ffest_first;	// to lexer.  */
-
-ffelexHandler
-ffest_first (ffelexToken t)
-{
-  return ffesta_first (t);
-}
-
-/* ffest_init_0 -- Initialize for entire image invocation
-
-   ffest_init_0();
-
-   Call just once per invocation of the compiler (not once per invocation
-   of the front end).
-
-   Gets memory for the list of possibles once and for all, since this
-   list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
-   and is not particularly large.  Initializes the array of pointers to
-   this list.  Initializes the executable and nonexecutable lists.  */
-
-void
-ffest_init_0 (void)
-{
-  ffesta_init_0 ();
-  ffestb_init_0 ();
-  ffestc_init_0 ();
-  ffestd_init_0 ();
-  ffeste_init_0 ();
-  ffestp_init_0 ();
-  ffestr_init_0 ();
-  ffests_init_0 ();
-  ffestt_init_0 ();
-  ffestu_init_0 ();
-  ffestv_init_0 ();
-  ffestw_init_0 ();
-}
-
-/* ffest_init_1 -- Initialize for entire image invocation
-
-   ffest_init_1();
-
-   Call just once per invocation of the compiler (not once per invocation
-   of the front end).
-
-   Gets memory for the list of possibles once and for all, since this
-   list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
-   and is not particularly large.  Initializes the array of pointers to
-   this list.  Initializes the executable and nonexecutable lists.  */
-
-void
-ffest_init_1 (void)
-{
-  ffesta_init_1 ();
-  ffestb_init_1 ();
-  ffestc_init_1 ();
-  ffestd_init_1 ();
-  ffeste_init_1 ();
-  ffestp_init_1 ();
-  ffestr_init_1 ();
-  ffests_init_1 ();
-  ffestt_init_1 ();
-  ffestu_init_1 ();
-  ffestv_init_1 ();
-  ffestw_init_1 ();
-}
-
-/* ffest_init_2 -- Initialize for entire image invocation
-
-   ffest_init_2();
-
-   Call just once per invocation of the compiler (not once per invocation
-   of the front end).
-
-   Gets memory for the list of possibles once and for all, since this
-   list never gets larger than a certain size (FFEST_maxPOSSIBLES_)
-   and is not particularly large.  Initializes the array of pointers to
-   this list.  Initializes the executable and nonexecutable lists.  */
-
-void
-ffest_init_2 (void)
-{
-  ffesta_init_2 ();
-  ffestb_init_2 ();
-  ffestc_init_2 ();
-  ffestd_init_2 ();
-  ffeste_init_2 ();
-  ffestp_init_2 ();
-  ffestr_init_2 ();
-  ffests_init_2 ();
-  ffestt_init_2 ();
-  ffestu_init_2 ();
-  ffestv_init_2 ();
-  ffestw_init_2 ();
-}
-
-/* ffest_init_3 -- Initialize for any program unit
-
-   ffest_init_3();  */
-
-void
-ffest_init_3 (void)
-{
-  ffesta_init_3 ();
-  ffestb_init_3 ();
-  ffestc_init_3 ();
-  ffestd_init_3 ();
-  ffeste_init_3 ();
-  ffestp_init_3 ();
-  ffestr_init_3 ();
-  ffests_init_3 ();
-  ffestt_init_3 ();
-  ffestu_init_3 ();
-  ffestv_init_3 ();
-  ffestw_init_3 ();
-
-  ffestw_display_state ();
-}
-
-/* ffest_init_4 -- Initialize for statement functions
-
-   ffest_init_4();  */
-
-void
-ffest_init_4 (void)
-{
-  ffesta_init_4 ();
-  ffestb_init_4 ();
-  ffestc_init_4 ();
-  ffestd_init_4 ();
-  ffeste_init_4 ();
-  ffestp_init_4 ();
-  ffestr_init_4 ();
-  ffests_init_4 ();
-  ffestt_init_4 ();
-  ffestu_init_4 ();
-  ffestv_init_4 ();
-  ffestw_init_4 ();
-}
-
-/* Test whether ENTRY statement is valid.
-
-   Returns TRUE if current program unit is known to be FUNCTION or SUBROUTINE.
-   Else returns FALSE.  */
-
-bool
-ffest_is_entry_valid (void)
-{
-  return ffesta_is_entry_valid;
-}
-
-/* ffest_is_inhibited -- Test whether the current possibility is inhibited
-
-   if (!ffest_is_inhibited())
-       // implement the statement.
-
-   Just make sure the current possibility has been confirmed.  If anyone
-   really needs to test whether the current possibility is inhibited prior
-   to confirming it, that indicates a need to begin statement processing
-   before it is certain that the given possibility is indeed the statement
-   to be processed.  As of this writing, there does not appear to be such
-   a need.  If there is, then when confirming a statement would normally
-   immediately disable the inhibition (whereas currently we leave the
-   confirmed statement disabled until we've tried the other possibilities,
-   to check for ambiguities), we must check to see if the possibility has
-   already tested for inhibition prior to confirmation and, if so, maintain
-   inhibition until the end of the statement (which may be forced right
-   away) and then rerun the entire statement from the beginning.  Otherwise,
-   initial calls to ffestb functions won't have been made, but subsequent
-   calls (after confirmation) will, which is wrong.  Of course, this all
-   applies only to those statements implemented via multiple calls to
-   ffestb, although if a statement requiring only a single ffestb call
-   tested for inhibition prior to confirmation, it would likely mean that
-   the ffestb call would be completely dropped without this mechanism.	*/
-
-bool
-ffest_is_inhibited (void)
-{
-  return ffesta_is_inhibited ();
-}
-
-/* ffest_seen_first_exec -- Test whether first executable stmt has been seen
-
-   if (ffest_seen_first_exec())
-       // No more spec stmts can be seen.
-
-   In a case where, say, the first statement is PARAMETER(A)=B, FALSE
-   will be returned while the PARAMETER statement is being run, and TRUE
-   will be returned if it doesn't confirm and the assignment statement
-   is being run.  */
-
-bool
-ffest_seen_first_exec (void)
-{
-  return ffesta_seen_first_exec;
-}
-
-/* Shut down current parsing possibility, but without bothering the
-   user with a diagnostic if we're not inhibited.  */
-
-void
-ffest_shutdown (void)
-{
-  ffesta_shutdown ();
-}
-
-/* ffest_sym_end_transition -- Update symbol info just before end of unit
-
-   ffesymbol s;
-   ffest_sym_end_transition(s);	 */
-
-ffesymbol
-ffest_sym_end_transition (ffesymbol s)
-{
-  return ffestu_sym_end_transition (s);
-}
-
-/* ffest_sym_exec_transition -- Update symbol just before first exec stmt
-
-   ffesymbol s;
-   ffest_sym_exec_transition(s);  */
-
-ffesymbol
-ffest_sym_exec_transition (ffesymbol s)
-{
-  return ffestu_sym_exec_transition (s);
-}
-
-/* ffest_terminate_0 -- Terminate for entire image invocation
-
-   ffest_terminate_0();	 */
-
-void
-ffest_terminate_0 (void)
-{
-  ffesta_terminate_0 ();
-  ffestb_terminate_0 ();
-  ffestc_terminate_0 ();
-  ffestd_terminate_0 ();
-  ffeste_terminate_0 ();
-  ffestp_terminate_0 ();
-  ffestr_terminate_0 ();
-  ffests_terminate_0 ();
-  ffestt_terminate_0 ();
-  ffestu_terminate_0 ();
-  ffestv_terminate_0 ();
-  ffestw_terminate_0 ();
-}
-
-/* ffest_terminate_1 -- Terminate for source file
-
-   ffest_terminate_1();	 */
-
-void
-ffest_terminate_1 (void)
-{
-  ffesta_terminate_1 ();
-  ffestb_terminate_1 ();
-  ffestc_terminate_1 ();
-  ffestd_terminate_1 ();
-  ffeste_terminate_1 ();
-  ffestp_terminate_1 ();
-  ffestr_terminate_1 ();
-  ffests_terminate_1 ();
-  ffestt_terminate_1 ();
-  ffestu_terminate_1 ();
-  ffestv_terminate_1 ();
-  ffestw_terminate_1 ();
-}
-
-/* ffest_terminate_2 -- Terminate for outer program unit
-
-   ffest_terminate_2();	 */
-
-void
-ffest_terminate_2 (void)
-{
-  ffesta_terminate_2 ();
-  ffestb_terminate_2 ();
-  ffestc_terminate_2 ();
-  ffestd_terminate_2 ();
-  ffeste_terminate_2 ();
-  ffestp_terminate_2 ();
-  ffestr_terminate_2 ();
-  ffests_terminate_2 ();
-  ffestt_terminate_2 ();
-  ffestu_terminate_2 ();
-  ffestv_terminate_2 ();
-  ffestw_terminate_2 ();
-}
-
-/* ffest_terminate_3 -- Terminate for any program unit
-
-   ffest_terminate_3();	 */
-
-void
-ffest_terminate_3 (void)
-{
-  ffesta_terminate_3 ();
-  ffestb_terminate_3 ();
-  ffestc_terminate_3 ();
-  ffestd_terminate_3 ();
-  ffeste_terminate_3 ();
-  ffestp_terminate_3 ();
-  ffestr_terminate_3 ();
-  ffests_terminate_3 ();
-  ffestt_terminate_3 ();
-  ffestu_terminate_3 ();
-  ffestv_terminate_3 ();
-  ffestw_terminate_3 ();
-}
-
-/* ffest_terminate_4 -- Terminate for statement functions
-
-   ffest_terminate_4();	 */
-
-void
-ffest_terminate_4 (void)
-{
-  ffesta_terminate_4 ();
-  ffestb_terminate_4 ();
-  ffestc_terminate_4 ();
-  ffestd_terminate_4 ();
-  ffeste_terminate_4 ();
-  ffestp_terminate_4 ();
-  ffestr_terminate_4 ();
-  ffests_terminate_4 ();
-  ffestt_terminate_4 ();
-  ffestu_terminate_4 ();
-  ffestv_terminate_4 ();
-  ffestw_terminate_4 ();
-}
diff --git a/gcc/f/st.h b/gcc/f/st.h
deleted file mode 100644
index 65b99f9..0000000
--- a/gcc/f/st.h
+++ /dev/null
@@ -1,81 +0,0 @@
-/* st.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      st.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_ST_H
-#define GCC_F_ST_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bad.h"
-#include "lex.h"
-#include "symbol.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffest_confirmed (void);
-void ffest_eof (void);
-bool ffest_ffebad_start (ffebad errnum);
-void ffest_ffebad_here_current_stmt (ffebadIndex i);
-void ffest_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
-ffelexHandler ffest_first (ffelexToken t);
-void ffest_init_0 (void);
-void ffest_init_1 (void);
-void ffest_init_2 (void);
-void ffest_init_3 (void);
-void ffest_init_4 (void);
-bool ffest_is_entry_valid (void);
-bool ffest_is_inhibited (void);
-bool ffest_seen_first_exec (void);
-void ffest_shutdown (void);
-ffesymbol ffest_sym_end_transition (ffesymbol s);
-ffesymbol ffest_sym_exec_transition (ffesymbol s);
-void ffest_terminate_0 (void);
-void ffest_terminate_1 (void);
-void ffest_terminate_2 (void);
-void ffest_terminate_3 (void);
-void ffest_terminate_4 (void);
-
-/* Define macros. */
-
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_ST_H */
diff --git a/gcc/f/sta.c b/gcc/f/sta.c
deleted file mode 100644
index ee75fa8..0000000
--- a/gcc/f/sta.c
+++ /dev/null
@@ -1,1722 +0,0 @@
-/* sta.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Analyzes the first two tokens, figures out what statements are
-      possible, tries parsing the possible statements by calling on
-      the ffestb functions.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "sta.h"
-#include "bad.h"
-#include "implic.h"
-#include "lex.h"
-#include "malloc.h"
-#include "stb.h"
-#include "stc.h"
-#include "std.h"
-#include "str.h"
-#include "storag.h"
-#include "symbol.h"
-
-/* Externals defined here. */
-
-ffelexToken ffesta_tokens[FFESTA_tokensMAX];	/* For use by a possible. */
-ffestrFirst ffesta_first_kw;	/* First NAME(S) looked up. */
-ffestrSecond ffesta_second_kw;	/* Second NAME(S) looked up. */
-mallocPool ffesta_output_pool;	/* Pool for results of stmt handling. */
-mallocPool ffesta_scratch_pool;	/* Pool for stmt scratch handling. */
-ffelexToken ffesta_construct_name;
-ffelexToken ffesta_label_token;	/* Pending label stuff. */
-bool ffesta_seen_first_exec;
-bool ffesta_is_entry_valid = FALSE;	/* TRUE only in SUBROUTINE/FUNCTION. */
-bool ffesta_line_has_semicolons = FALSE;
-
-/* Simple definitions and enumerations. */
-
-#define FFESTA_ABORT_ON_CONFIRM_ 1	/* 0=slow, tested way; 1=faster way
-					   that might not always work. Here's
-					   the old description of what used
-					   to not work with ==1: (try
-					   "CONTINUE\10
-					   FORMAT('hi',I11)\END").  Problem
-					   is that the "topology" of the
-					   confirmed stmt's tokens with
-					   regard to CHARACTER, HOLLERITH,
-					   NAME/NAMES/NUMBER tokens (like hex
-					   numbers), isn't traced if we abort
-					   early, then other stmts might get
-					   their grubby hands on those
-					   unprocessed tokens and commit them
-					   improperly.	Ideal fix is to rerun
-					   the confirmed stmt and forget the
-					   rest.  */
-
-#define FFESTA_maxPOSSIBLES_ 8/* Never more than this # of possibles. */
-
-/* Internal typedefs. */
-
-typedef struct _ffesta_possible_ *ffestaPossible_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffesta_possible_
-  {
-    ffestaPossible_ next;
-    ffestaPossible_ previous;
-    ffelexHandler handler;
-    bool named;
-  };
-
-struct _ffesta_possible_root_
-  {
-    ffestaPossible_ first;
-    ffestaPossible_ last;
-    ffelexHandler nil;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-static bool ffesta_is_inhibited_ = FALSE;
-static ffelexToken ffesta_token_0_;	/* For use by ffest possibility
-					   handling. */
-static ffestaPossible_ ffesta_possibles_[FFESTA_maxPOSSIBLES_];
-static int ffesta_num_possibles_ = 0;	/* Number of possibilities. */
-static struct _ffesta_possible_root_ ffesta_possible_nonexecs_;
-static struct _ffesta_possible_root_ ffesta_possible_execs_;
-static ffestaPossible_ ffesta_current_possible_;
-static ffelexHandler ffesta_current_handler_;
-static bool ffesta_confirmed_current_ = FALSE;
-static bool ffesta_confirmed_other_ = FALSE;
-static ffestaPossible_ ffesta_confirmed_possible_;
-static bool ffesta_current_shutdown_ = FALSE;
-#if !FFESTA_ABORT_ON_CONFIRM_
-static bool ffesta_is_two_into_statement_ = FALSE;	/* For IF, WHERE stmts. */
-static ffelexToken ffesta_twotokens_1_;	/* For IF, WHERE stmts. */
-static ffelexToken ffesta_twotokens_2_;	/* For IF, WHERE stmts. */
-#endif
-static ffestaPooldisp ffesta_outpooldisp_;	/* After statement dealt
-						   with. */
-static bool ffesta_inhibit_confirmation_ = FALSE;
-
-/* Static functions (internal). */
-
-static void ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named);
-static bool ffesta_inhibited_exec_transition_ (void);
-static void ffesta_reset_possibles_ (void);
-static ffelexHandler ffesta_save_ (ffelexToken t);
-static ffelexHandler ffesta_second_ (ffelexToken t);
-#if !FFESTA_ABORT_ON_CONFIRM_
-static ffelexHandler ffesta_send_two_ (ffelexToken t);
-#endif
-
-/* Internal macros. */
-
-#define ffesta_add_possible_exec_(fn) (ffesta_add_possible_ (fn, TRUE, TRUE))
-#define ffesta_add_possible_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, TRUE))
-#define ffesta_add_possible_unnamed_exec_(fn) (ffesta_add_possible_ (fn, TRUE, FALSE))
-#define ffesta_add_possible_unnamed_nonexec_(fn) (ffesta_add_possible_ (fn, FALSE, FALSE))
-
-/* Add possible statement to appropriate list.  */
-
-static void
-ffesta_add_possible_ (ffelexHandler fn, bool exec, bool named)
-{
-  ffestaPossible_ p;
-
-  assert (ffesta_num_possibles_ < FFESTA_maxPOSSIBLES_);
-
-  p = ffesta_possibles_[ffesta_num_possibles_++];
-
-  if (exec)
-    {
-      p->next = (ffestaPossible_) &ffesta_possible_execs_.first;
-      p->previous = ffesta_possible_execs_.last;
-    }
-  else
-    {
-      p->next = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
-      p->previous = ffesta_possible_nonexecs_.last;
-    }
-  p->next->previous = p;
-  p->previous->next = p;
-
-  p->handler = fn;
-  p->named = named;
-}
-
-/* ffesta_inhibited_exec_transition_ -- Do exec transition while inhibited
-
-   if (!ffesta_inhibited_exec_transition_())  // couldn't transition...
-
-   Invokes ffestc_exec_transition, but first enables ffebad and ffesta and
-   afterwards disables them again.  Then returns the result of the
-   invocation of ffestc_exec_transition.  */
-
-static bool
-ffesta_inhibited_exec_transition_ (void)
-{
-  bool result;
-
-  assert (ffebad_inhibit ());
-  assert (ffesta_is_inhibited_);
-
-  ffebad_set_inhibit (FALSE);
-  ffesta_is_inhibited_ = FALSE;
-
-  result = ffestc_exec_transition ();
-
-  ffebad_set_inhibit (TRUE);
-  ffesta_is_inhibited_ = TRUE;
-
-  return result;
-}
-
-/* ffesta_reset_possibles_ -- Reset (clear) lists of possible statements
-
-   ffesta_reset_possibles_();
-
-   Clears the lists of executable and nonexecutable statements.	 */
-
-static void
-ffesta_reset_possibles_ (void)
-{
-  ffesta_num_possibles_ = 0;
-
-  ffesta_possible_execs_.first = ffesta_possible_execs_.last
-    = (ffestaPossible_) &ffesta_possible_execs_.first;
-  ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last
-    = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
-}
-
-/* ffesta_save_ -- Save token on list, pass thru to current handler
-
-   return ffesta_save_;	 // to lexer.
-
-   Receives a token from the lexer.  Saves it in the list of tokens.  Calls
-   the current handler with the token.
-
-   If no shutdown error occurred (via
-   ffest_ffebad_start), then if the token was EOS or SEMICOLON, mark the
-   current possible as successful and confirmed but try the next possible
-   anyway until ambiguities in the form handling are ironed out.  */
-
-static ffelexHandler
-ffesta_save_ (ffelexToken t)
-{
-  static ffelexToken *saved_tokens = NULL;	/* A variable-sized array. */
-  static unsigned int num_saved_tokens = 0;	/* Number currently saved. */
-  static unsigned int max_saved_tokens = 0;	/* Maximum to be saved. */
-  unsigned int toknum;		/* Index into saved_tokens array. */
-  ffelexToken eos;		/* EOS created on-the-fly for shutdown
-				   purposes. */
-  ffelexToken t2;		/* Another temporary token (no intersect with
-				   eos, btw). */
-
-  /* Save the current token. */
-
-  if (saved_tokens == NULL)
-    {
-      saved_tokens
-	= 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)
-    {
-      toknum = max_saved_tokens;
-      max_saved_tokens <<= 1;	/* Multiply by two. */
-      assert (max_saved_tokens > toknum);
-      saved_tokens
-	= 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);
-
-  /* Transmit the current token to the current handler. */
-
-  ffesta_current_handler_ = (ffelexHandler) (*ffesta_current_handler_) (t);
-
-  /* See if this possible has been shut down, or confirmed in which case we
-     might as well shut it down anyway to save time. */
-
-  if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_
-				    && ffesta_confirmed_current_))
-      && !ffelex_expecting_character ())
-    {
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-
-	default:
-	  eos = ffelex_token_new_eos (ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));
-	  ffesta_inhibit_confirmation_ = ffesta_current_shutdown_;
-	  (*ffesta_current_handler_) (eos);
-	  ffesta_inhibit_confirmation_ = FALSE;
-	  ffelex_token_kill (eos);
-	  break;
-	}
-    }
-  else
-    {
-
-      /* If this is an EOS or SEMICOLON token, switch to next handler, else
-	 return self as next handler for lexer. */
-
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-
-	default:
-	  return (ffelexHandler) ffesta_save_;
-	}
-    }
-
- next_handler:			/* :::::::::::::::::::: */
-
-  /* Note that a shutdown also happens after seeing the first two tokens
-     after "IF (expr)" or "WHERE (expr)" where a statement follows, even
-     though there is no error.	This causes the IF or WHERE form to be
-     implemented first before ffest_first is called for the first token in
-     the following statement. */
-
-  if (ffesta_current_shutdown_)
-    ffesta_current_shutdown_ = FALSE;	/* Only after sending EOS! */
-  else
-    assert (ffesta_confirmed_current_);
-
-  if (ffesta_confirmed_current_)
-    {
-      ffesta_confirmed_current_ = FALSE;
-      ffesta_confirmed_other_ = TRUE;
-    }
-
-  /* Pick next handler. */
-
-  ffesta_current_possible_ = ffesta_current_possible_->next;
-  ffesta_current_handler_ = ffesta_current_possible_->handler;
-  if (ffesta_current_handler_ == NULL)
-    {				/* No handler in this list, try exec list if
-				   not tried yet. */
-      if (ffesta_current_possible_
-	  == (ffestaPossible_) &ffesta_possible_nonexecs_.first)
-	{
-	  ffesta_current_possible_ = ffesta_possible_execs_.first;
-	  ffesta_current_handler_ = ffesta_current_possible_->handler;
-	}
-      if ((ffesta_current_handler_ == NULL)
-	  || (!ffesta_seen_first_exec
-	      && ((ffesta_confirmed_possible_ != NULL)
-		  || !ffesta_inhibited_exec_transition_ ())))
-	/* Don't run execs if:	  (decoding the "if" ^^^ up here ^^^) - we
-	   have no exec handler available, or - we haven't seen the first
-	   executable statement yet, and - we've confirmed a nonexec
-	   (otherwise even a nonexec would cause a transition), or - a
-	   nonexec-to-exec transition can't be made at the statement context
-	   level (as in an executable statement in the middle of a STRUCTURE
-	   definition); if it can be made, ffestc_exec_transition makes the
-	   corresponding transition at the statement state level so
-	   specification statements are no longer accepted following an
-	   unrecognized statement.  (Note: it is valid for f_e_t_ to decide
-	   to always return TRUE by "shrieking" away the statement state
-	   stack until a transitionable state is reached.  Or it can leave
-	   the stack as is and return FALSE.)
-
-	   If we decide not to run execs, enter this block to rerun the
-	   confirmed statement, if any. */
-	{			/* At end of both lists!  Pick confirmed or
-				   first possible. */
-	  ffebad_set_inhibit (FALSE);
-	  ffesta_is_inhibited_ = FALSE;
-	  ffesta_confirmed_other_ = FALSE;
-	  ffesta_tokens[0] = ffesta_token_0_;
-	  if (ffesta_confirmed_possible_ == NULL)
-	    {			/* No confirmed success, just use first
-				   named possible, or first possible if
-				   no named possibles. */
-	      ffestaPossible_ possible = ffesta_possible_nonexecs_.first;
-	      ffestaPossible_ first = NULL;
-	      ffestaPossible_ first_named = NULL;
-	      ffestaPossible_ first_exec = NULL;
-
-	      for (;;)
-		{
-		  if (possible->handler == NULL)
-		    {
-		      if (possible == (ffestaPossible_) &ffesta_possible_nonexecs_.first)
-			{
-			  possible = first_exec = ffesta_possible_execs_.first;
-			  continue;
-			}
-		      else
-			break;
-		    }
-		  if (first == NULL)
-		    first = possible;
-		  if (possible->named
-		      && (first_named == NULL))
-		    first_named = possible;
-
-		  possible = possible->next;
-		}
-
-	      if (first_named != NULL)
-		ffesta_current_possible_ = first_named;
-	      else if (ffesta_seen_first_exec
-		       && (first_exec != NULL))
-		ffesta_current_possible_ = first_exec;
-	      else
-		ffesta_current_possible_ = first;
-
-	      ffesta_current_handler_ = ffesta_current_possible_->handler;
-	      assert (ffesta_current_handler_ != NULL);
-	    }
-	  else
-	    {			/* Confirmed success, use it. */
-	      ffesta_current_possible_ = ffesta_confirmed_possible_;
-	      ffesta_current_handler_ = ffesta_confirmed_possible_->handler;
-	    }
-	  ffesta_reset_possibles_ ();
-	}
-      else
-	{			/* Switching from [empty?] list of nonexecs
-				   to nonempty list of execs at this point. */
-	  ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
-	  ffesymbol_set_retractable (ffesta_scratch_pool);
-	}
-    }
-  else
-    {
-      ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
-      ffesymbol_set_retractable (ffesta_scratch_pool);
-    }
-
-  /* Send saved tokens to current handler until either shut down or all
-     tokens sent. */
-
-  for (toknum = 0; toknum < num_saved_tokens; ++toknum)
-    {
-      t = *(saved_tokens + toknum);
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCHARACTER:
-	  ffelex_set_expecting_hollerith (0, '\0',
-					  ffewhere_line_unknown (),
-					  ffewhere_column_unknown ());
-	  ffesta_current_handler_
-	    = (ffelexHandler) (*ffesta_current_handler_) (t);
-	  break;
-
-	case FFELEX_typeNAMES:
-	  if (ffelex_is_names_expected ())
-	    ffesta_current_handler_
-	      = (ffelexHandler) (*ffesta_current_handler_) (t);
-	  else
-	    {
-	      t2 = ffelex_token_name_from_names (t, 0, 0);
-	      ffesta_current_handler_
-		= (ffelexHandler) (*ffesta_current_handler_) (t2);
-	      ffelex_token_kill (t2);
-	    }
-	  break;
-
-	default:
-	  ffesta_current_handler_
-	    = (ffelexHandler) (*ffesta_current_handler_) (t);
-	  break;
-	}
-
-      if (!ffesta_is_inhibited_)
-	ffelex_token_kill (t);	/* Won't need this any more. */
-
-      /* See if this possible has been shut down. */
-
-      else if ((ffesta_current_shutdown_ || (FFESTA_ABORT_ON_CONFIRM_
-					     && ffesta_confirmed_current_))
-	       && !ffelex_expecting_character ())
-	{
-	  switch (ffelex_token_type (t))
-	    {
-	    case FFELEX_typeEOS:
-	    case FFELEX_typeSEMICOLON:
-	      break;
-
-	    default:
-	      eos = ffelex_token_new_eos (ffelex_token_where_line (t),
-					  ffelex_token_where_column (t));
-	      ffesta_inhibit_confirmation_ = ffesta_current_shutdown_;
-	      (*ffesta_current_handler_) (eos);
-	      ffesta_inhibit_confirmation_ = FALSE;
-	      ffelex_token_kill (eos);
-	      break;
-	    }
-	  goto next_handler;	/* :::::::::::::::::::: */
-	}
-    }
-
-  /* Finished sending all the tokens so far.  If still trying possibilities,
-     then if we've just sent an EOS or SEMICOLON token through, go to the
-     next handler.  Otherwise, return self so we can gather and process more
-     tokens. */
-
-  if (ffesta_is_inhibited_)
-    {
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  goto next_handler;	/* :::::::::::::::::::: */
-
-	default:
-#if FFESTA_ABORT_ON_CONFIRM_
-	  assert (!ffesta_confirmed_other_);	/* Catch ambiguities. */
-#endif
-	  return (ffelexHandler) ffesta_save_;
-	}
-    }
-
-  /* This was the one final possibility, uninhibited, so send the final
-     handler it sent. */
-
-  num_saved_tokens = 0;
-#if !FFESTA_ABORT_ON_CONFIRM_
-  if (ffesta_is_two_into_statement_)
-    {				/* End of the line for the previous two
-				   tokens, resurrect them. */
-      ffelexHandler next;
-
-      ffesta_is_two_into_statement_ = FALSE;
-      next = (ffelexHandler) ffesta_first (ffesta_twotokens_1_);
-      ffelex_token_kill (ffesta_twotokens_1_);
-      next = (ffelexHandler) (*next) (ffesta_twotokens_2_);
-      ffelex_token_kill (ffesta_twotokens_2_);
-      return (ffelexHandler) next;
-    }
-#endif
-
-  assert (ffesta_current_handler_ != NULL);
-  return (ffelexHandler) ffesta_current_handler_;
-}
-
-/* ffesta_second_ -- Parse the token after a NAME/NAMES in a statement
-
-   return ffesta_second_;  // to lexer.
-
-   The second token cannot be a NAMES, since the first token is a NAME or
-   NAMES.  If the second token is a NAME, look up its name in the list of
-   second names for use by whoever needs it.
-
-   Then make a list of all the possible statements this could be, based on
-   looking at the first two tokens.  Two lists of possible statements are
-   created, one consisting of nonexecutable statements, the other consisting
-   of executable statements.
-
-   If the total number of possibilities is one, just fire up that
-   possibility by calling its handler function, passing the first two
-   tokens through it and so on.
-
-   Otherwise, start up a process whereby tokens are passed to the first
-   possibility on the list until EOS or SEMICOLON is reached or an error
-   is detected.	 But inhibit any actual reporting of errors; just record
-   their existence in the list.	 If EOS or SEMICOLON is reached with no
-   errors (other than non-form errors happening downstream, such as an
-   overflowing value for an integer or a GOTO statement identifying a label
-   on a FORMAT statement), then that is the only possible statement.  Rerun
-   the statement with error-reporting turned on if any non-form errors were
-   generated, otherwise just use its results, then erase the list of tokens
-   memorized during the search process.	 If a form error occurs, immediately
-   cancel that possibility by sending EOS as the next token, remember the
-   error code for that possibility, and try the next possibility on the list,
-   first sending it the list of tokens memorized while handling the first
-   possibility, then continuing on as before.
-
-   Ultimately, either the end of the list of possibilities will be reached
-   without any successful forms being detected, in which case we pick one
-   based on hueristics (usually the first possibility) and rerun it with
-   error reporting turned on using the list of memorized tokens so the user
-   sees the error, or one of the possibilities will effectively succeed.  */
-
-static ffelexHandler
-ffesta_second_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffesymbol s;
-
-  assert (ffelex_token_type (t) != FFELEX_typeNAMES);
-
-  if (ffelex_token_type (t) == FFELEX_typeNAME)
-    ffesta_second_kw = ffestr_second (t);
-
-  /* Here we use switch on the first keyword name and handle each possible
-     recognizable name by looking at the second token, and building the list
-     of possible names accordingly.  For now, just put every possible
-     statement on the list for ambiguity checking. */
-
-  switch (ffesta_first_kw)
-    {
-    case FFESTR_firstASSIGN:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R838);
-      break;
-
-    case FFESTR_firstBACKSPACE:
-      ffestb_args.beru.len = FFESTR_firstlBACKSPACE;
-      ffestb_args.beru.badname = "BACKSPACE";
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
-      break;
-
-    case FFESTR_firstBLOCK:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_block);
-      break;
-
-    case FFESTR_firstBLOCKDATA:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_blockdata);
-      break;
-
-    case FFESTR_firstBYTE:
-      ffestb_args.decl.len = FFESTR_firstlBYTE;
-      ffestb_args.decl.type = FFESTP_typeBYTE;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
-      break;
-
-    case FFESTR_firstCALL:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1212);
-      break;
-
-    case FFESTR_firstCASE:
-    case FFESTR_firstCASEDEFAULT:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R810);
-      break;
-
-    case FFESTR_firstCHRCTR:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_chartype);
-      break;
-
-    case FFESTR_firstCLOSE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R907);
-      break;
-
-    case FFESTR_firstCOMMON:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R547);
-      break;
-
-    case FFESTR_firstCMPLX:
-      ffestb_args.decl.len = FFESTR_firstlCMPLX;
-      ffestb_args.decl.type = FFESTP_typeCOMPLEX;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
-      break;
-
-    case FFESTR_firstCONTINUE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R841);
-      break;
-
-    case FFESTR_firstCYCLE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R834);
-      break;
-
-    case FFESTR_firstDATA:
-      if (ffe_is_pedantic_not_90 ())
-	ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R528);
-      else
-	ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R528);
-      break;
-
-    case FFESTR_firstDIMENSION:
-      ffestb_args.R524.len = FFESTR_firstlDIMENSION;
-      ffestb_args.R524.badname = "DIMENSION";
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524);
-      break;
-
-    case FFESTR_firstDO:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_do);
-      break;
-
-    case FFESTR_firstDBL:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_double);
-      break;
-
-    case FFESTR_firstDBLCMPLX:
-      ffestb_args.decl.len = FFESTR_firstlDBLCMPLX;
-      ffestb_args.decl.type = FFESTP_typeDBLCMPLX;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_dbltype);
-      break;
-
-    case FFESTR_firstDBLPRCSN:
-      ffestb_args.decl.len = FFESTR_firstlDBLPRCSN;
-      ffestb_args.decl.type = FFESTP_typeDBLPRCSN;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_dbltype);
-      break;
-
-    case FFESTR_firstDOWHILE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_dowhile);
-      break;
-
-    case FFESTR_firstELSE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_else);
-      break;
-
-    case FFESTR_firstELSEIF:
-      ffestb_args.elsexyz.second = FFESTR_secondIF;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_elsexyz);
-      break;
-
-    case FFESTR_firstEND:
-      if ((ffelex_token_type (ffesta_token_0_) == FFELEX_typeNAMES)
-	  || (ffelex_token_type (t) != FFELEX_typeNAME))
-	ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end);
-      else
-	{
-	  switch (ffesta_second_kw)
-	    {
-	    case FFESTR_secondBLOCK:
-	    case FFESTR_secondBLOCKDATA:
-	    case FFESTR_secondDO:
-	    case FFESTR_secondFILE:
-	    case FFESTR_secondFUNCTION:
-	    case FFESTR_secondIF:
-	    case FFESTR_secondPROGRAM:
-	    case FFESTR_secondSELECT:
-	    case FFESTR_secondSUBROUTINE:
-	      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_end);
-	      break;
-
-	    default:
-	      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_end);
-	      break;
-	    }
-	}
-      break;
-
-    case FFESTR_firstENDBLOCK:
-      ffestb_args.endxyz.len = FFESTR_firstlENDBLOCK;
-      ffestb_args.endxyz.second = FFESTR_secondBLOCK;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDBLOCKDATA:
-      ffestb_args.endxyz.len = FFESTR_firstlENDBLOCKDATA;
-      ffestb_args.endxyz.second = FFESTR_secondBLOCKDATA;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDDO:
-      ffestb_args.endxyz.len = FFESTR_firstlENDDO;
-      ffestb_args.endxyz.second = FFESTR_secondDO;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDFILE:
-      ffestb_args.beru.len = FFESTR_firstlENDFILE;
-      ffestb_args.beru.badname = "ENDFILE";
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
-      break;
-
-    case FFESTR_firstENDFUNCTION:
-      ffestb_args.endxyz.len = FFESTR_firstlENDFUNCTION;
-      ffestb_args.endxyz.second = FFESTR_secondFUNCTION;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDIF:
-      ffestb_args.endxyz.len = FFESTR_firstlENDIF;
-      ffestb_args.endxyz.second = FFESTR_secondIF;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDPROGRAM:
-      ffestb_args.endxyz.len = FFESTR_firstlENDPROGRAM;
-      ffestb_args.endxyz.second = FFESTR_secondPROGRAM;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDSELECT:
-      ffestb_args.endxyz.len = FFESTR_firstlENDSELECT;
-      ffestb_args.endxyz.second = FFESTR_secondSELECT;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENDSUBROUTINE:
-      ffestb_args.endxyz.len = FFESTR_firstlENDSUBROUTINE;
-      ffestb_args.endxyz.second = FFESTR_secondSUBROUTINE;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_endxyz);
-      break;
-
-    case FFESTR_firstENTRY:
-      ffestb_args.dummy.len = FFESTR_firstlENTRY;
-      ffestb_args.dummy.badname = "ENTRY";
-      ffestb_args.dummy.is_subr = ffestc_is_entry_in_subr ();
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy);
-      break;
-
-    case FFESTR_firstEQUIVALENCE:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R544);
-      break;
-
-    case FFESTR_firstEXIT:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R835);
-      break;
-
-    case FFESTR_firstEXTERNAL:
-      ffestb_args.varlist.len = FFESTR_firstlEXTERNAL;
-      ffestb_args.varlist.badname = "EXTERNAL";
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
-      break;
-
-      /* 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
-	 ffelex_set_names_pure(TRUE), to make sure the lexer delivers NAMES
-	 tokens. */
-
-    case FFESTR_firstFORMAT:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1001);
-      break;
-
-    case FFESTR_firstFUNCTION:
-      ffestb_args.dummy.len = FFESTR_firstlFUNCTION;
-      ffestb_args.dummy.badname = "FUNCTION";
-      ffestb_args.dummy.is_subr = FALSE;
-      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;
-
-    case FFESTR_firstIF:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_if);
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R840);
-      break;
-
-    case FFESTR_firstIMPLICIT:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_R539);
-      break;
-
-    case FFESTR_firstINCLUDE:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_S3P4);
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeNUMBER:
-	case FFELEX_typeNAME:
-	case FFELEX_typeAPOSTROPHE:
-	case FFELEX_typeQUOTE:
-	  break;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFESTR_firstINQUIRE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R923);
-      break;
-
-    case FFESTR_firstINTGR:
-      ffestb_args.decl.len = FFESTR_firstlINTGR;
-      ffestb_args.decl.type = FFESTP_typeINTEGER;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
-      break;
-
-    case FFESTR_firstINTRINSIC:
-      ffestb_args.varlist.len = FFESTR_firstlINTRINSIC;
-      ffestb_args.varlist.badname = "INTRINSIC";
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_varlist);
-      break;
-
-    case FFESTR_firstLGCL:
-      ffestb_args.decl.len = FFESTR_firstlLGCL;
-      ffestb_args.decl.type = FFESTP_typeLOGICAL;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
-      break;
-
-    case FFESTR_firstNAMELIST:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R542);
-      break;
-
-    case FFESTR_firstOPEN:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R904);
-      break;
-
-    case FFESTR_firstPARAMETER:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R537);
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V027);
-      break;
-
-    case FFESTR_firstPAUSE:
-      ffestb_args.halt.len = FFESTR_firstlPAUSE;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt);
-      break;
-
-    case FFESTR_firstPRINT:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R911);
-      break;
-
-    case FFESTR_firstPROGRAM:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R1102);
-      break;
-
-    case FFESTR_firstREAD:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R909);
-      break;
-
-    case FFESTR_firstREAL:
-      ffestb_args.decl.len = FFESTR_firstlREAL;
-      ffestb_args.decl.type = FFESTP_typeREAL;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
-      break;
-
-    case FFESTR_firstRETURN:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R1227);
-      break;
-
-    case FFESTR_firstREWIND:
-      ffestb_args.beru.len = FFESTR_firstlREWIND;
-      ffestb_args.beru.badname = "REWIND";
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_beru);
-      break;
-
-    case FFESTR_firstSAVE:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R522);
-      break;
-
-    case FFESTR_firstSELECT:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809);
-      break;
-
-    case FFESTR_firstSELECTCASE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R809);
-      break;
-
-    case FFESTR_firstSTOP:
-      ffestb_args.halt.len = FFESTR_firstlSTOP;
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_halt);
-      break;
-
-    case FFESTR_firstSUBROUTINE:
-      ffestb_args.dummy.len = FFESTR_firstlSUBROUTINE;
-      ffestb_args.dummy.badname = "SUBROUTINE";
-      ffestb_args.dummy.is_subr = TRUE;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_dummy);
-      break;
-
-    case FFESTR_firstTYPE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_V020);
-      break;
-
-    case FFESTR_firstVIRTUAL:
-      ffestb_args.R524.len = FFESTR_firstlVIRTUAL;
-      ffestb_args.R524.badname = "VIRTUAL";
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_R524);
-      break;
-
-    case FFESTR_firstVOLATILE:
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_V014);
-      break;
-
-    case FFESTR_firstWORD:
-      ffestb_args.decl.len = FFESTR_firstlWORD;
-      ffestb_args.decl.type = FFESTP_typeWORD;
-      ffesta_add_possible_nonexec_ ((ffelexHandler) ffestb_decl_gentype);
-      break;
-
-    case FFESTR_firstWRITE:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_R910);
-      break;
-
-    default:
-      break;
-    }
-
-  /* Now check the default cases, which are always "live" (meaning that no
-     other possibility can override them).  These are where the second token
-     is OPEN_PAREN, PERCENT, EQUALS, POINTS, or COLON. */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      s = ffesymbol_lookup_local (ffesta_token_0_);
-      if (((s == NULL) || (ffesymbol_dims (s) == NULL))
-	  && !ffesta_seen_first_exec)
-	{			/* Not known as array; may be stmt function. */
-	  ffesta_add_possible_unnamed_nonexec_ ((ffelexHandler) ffestb_R1229);
-
-	  /* If the symbol is (or will be due to implicit typing) of
-	     CHARACTER type, then the statement might be an assignment
-	     statement.	 If so, since it can't be a function invocation nor
-	     an array element reference, the open paren following the symbol
-	     name must be followed by an expression and a colon.  Without the
-	     colon (which cannot appear in a stmt function definition), the
-	     let stmt rejects.	So CHARACTER_NAME(...)=expr, unlike any other
-	     type, is not ambiguous alone. */
-
-	  if (ffeimplic_peek_symbol_type (s,
-					ffelex_token_text (ffesta_token_0_))
-	      == FFEINFO_basictypeCHARACTER)
-	    ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
-	}
-      else			/* Not statement function if known as an
-				   array. */
-	ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
-      break;
-
-    case FFELEX_typeEQUALS:
-      ffesta_add_possible_unnamed_exec_ ((ffelexHandler) ffestb_let);
-      break;
-
-    case FFELEX_typeCOLON:
-      ffesta_add_possible_exec_ ((ffelexHandler) ffestb_construct);
-      break;
-
-    default:
-      ;
-    }
-
-  /* Now see how many possibilities are on the list. */
-
-  switch (ffesta_num_possibles_)
-    {
-    case 0:			/* None, so invalid statement. */
-    no_stmts:			/* :::::::::::::::::::: */
-      ffesta_tokens[0] = ffesta_token_0_;
-      ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_token_0_, t);
-      next = (ffelexHandler) ffelex_swallow_tokens (NULL,
-					       (ffelexHandler) ffesta_zero);
-      break;
-
-    case 1:			/* One, so just do it! */
-      ffesta_tokens[0] = ffesta_token_0_;
-      next = ffesta_possible_execs_.first->handler;
-      if (next == NULL)
-	{			/* Have a nonexec stmt. */
-	  next = ffesta_possible_nonexecs_.first->handler;
-	  assert (next != NULL);
-	}
-      else if (ffesta_seen_first_exec)
-	;			/* Have an exec stmt after exec transition. */
-      else if (!ffestc_exec_transition ())
-	/* 1 exec stmt only, but not valid in context, so pretend as though
-	   statement is unrecognized. */
-	goto no_stmts;		/* :::::::::::::::::::: */
-      break;
-
-    default:			/* More than one, so try them in order. */
-      ffesta_confirmed_possible_ = NULL;
-      ffesta_current_possible_ = ffesta_possible_nonexecs_.first;
-      ffesta_current_handler_ = ffesta_current_possible_->handler;
-      if (ffesta_current_handler_ == NULL)
-	{
-	  ffesta_current_possible_ = ffesta_possible_execs_.first;
-	  ffesta_current_handler_ = ffesta_current_possible_->handler;
-	  assert (ffesta_current_handler_ != NULL);
-	  if (!ffesta_seen_first_exec)
-	    {			/* Need to do exec transition now. */
-	      ffesta_tokens[0] = ffesta_token_0_;
-	      if (!ffestc_exec_transition ())
-		goto no_stmts;	/* :::::::::::::::::::: */
-	    }
-	}
-      ffesta_tokens[0] = ffelex_token_use (ffesta_token_0_);
-      next = (ffelexHandler) ffesta_save_;
-      ffebad_set_inhibit (TRUE);
-      ffesta_is_inhibited_ = TRUE;
-      break;
-    }
-
-  ffesta_output_pool
-    = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024);
-  ffesta_scratch_pool
-    = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024);
-  ffesta_outpooldisp_ = FFESTA_pooldispDISCARD;
-
-  if (ffesta_is_inhibited_)
-    ffesymbol_set_retractable (ffesta_scratch_pool);
-
-  ffelex_set_names (FALSE);	/* Most handlers will want this.  If not,
-				   they have to set it TRUE again (its value
-				   at the beginning of a statement). */
-
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffesta_send_two_ -- Send the two tokens saved by ffesta_two after all
-
-   return ffesta_send_two_;  // to lexer.
-
-   Currently, if this function gets called, it means that the two tokens
-   saved by ffesta_two did not have their handlers derailed by
-   ffesta_save_, which probably means they weren't sent by ffesta_save_
-   but directly by the lexer, which probably means the original statement
-   (which should be IF (expr) or WHERE (expr)) somehow evaluated to only
-   one possibility in ffesta_second_ or somebody optimized FFEST to
-   immediately revert to one possibility upon confirmation but forgot to
-   change this function (and thus perhaps the entire resubmission
-   mechanism).	*/
-
-#if !FFESTA_ABORT_ON_CONFIRM_
-static ffelexHandler
-ffesta_send_two_ (ffelexToken t)
-{
-  assert ("what am I doing here?" == NULL);
-  return NULL;
-}
-
-#endif
-/* ffesta_confirmed -- Confirm current possibility as only one
-
-   ffesta_confirmed();
-
-   Sets the confirmation flag.	During debugging for ambiguous constructs,
-   asserts that the confirmation flag for a previous possibility has not
-   yet been set.  */
-
-void
-ffesta_confirmed (void)
-{
-  if (ffesta_inhibit_confirmation_)
-    return;
-  ffesta_confirmed_current_ = TRUE;
-  assert (!ffesta_confirmed_other_
-	  || (ffesta_confirmed_possible_ == ffesta_current_possible_));
-  ffesta_confirmed_possible_ = ffesta_current_possible_;
-}
-
-/* ffesta_eof -- End of (non-INCLUDEd) source file
-
-   ffesta_eof();
-
-   Call after piping tokens through ffest_first, where the most recent
-   token sent through must be EOS.
-
-   20-Feb-91  JCB  1.1
-      Put new EOF token in ffesta_tokens[0], not NULL, because too much
-      code expects something there for error reporting and the like.  Also,
-      do basically the same things ffest_second and ffesta_zero do for
-      processing a statement (make and destroy pools, et cetera).  */
-
-void
-ffesta_eof (void)
-{
-  ffesta_tokens[0] = ffelex_token_new_eof ();
-
-  ffesta_output_pool
-    = malloc_pool_new ("Statement Output", ffe_pool_program_unit (), 1024);
-  ffesta_scratch_pool
-    = malloc_pool_new ("Statement Scratch", ffe_pool_program_unit (), 1024);
-  ffesta_outpooldisp_ = FFESTA_pooldispDISCARD;
-
-  ffestc_eof ();
-
-  if (ffesta_tokens[0] != NULL)
-    ffelex_token_kill (ffesta_tokens[0]);
-
-  if (ffesta_output_pool != NULL)
-    {
-      if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
-	malloc_pool_kill (ffesta_output_pool);
-      ffesta_output_pool = NULL;
-    }
-
-  if (ffesta_scratch_pool != NULL)
-    {
-      malloc_pool_kill (ffesta_scratch_pool);
-      ffesta_scratch_pool = NULL;
-    }
-
-  if (ffesta_label_token != NULL)
-    {
-      ffelex_token_kill (ffesta_label_token);
-      ffesta_label_token = NULL;
-    }
-
-  if (ffe_is_ffedebug ())
-    {
-      ffestorag_report ();
-    }
-}
-
-/* ffesta_ffebad_here_current_stmt -- ffebad_here with ptr to current stmt
-
-   ffesta_ffebad_here_current_stmt(0);
-
-   Outsiders can call this fn if they have no more convenient place to
-   point to (via a token or pair of ffewhere objects) and they know a
-   current, useful statement is being evaluted by ffest (i.e. they are
-   being called from ffestb, ffestc, ffestd, ... functions).  */
-
-void
-ffesta_ffebad_here_current_stmt (ffebadIndex i)
-{
-  assert (ffesta_tokens[0] != NULL);
-  ffebad_here (i, ffelex_token_where_line (ffesta_tokens[0]),
-	       ffelex_token_where_column (ffesta_tokens[0]));
-}
-
-/* ffesta_ffebad_start -- Start a possibly inhibited error report
-
-   if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))
-       {
-       ffebad_here, ffebad_string ...;
-       ffebad_finish();
-       }
-
-   Call if the error might indicate that ffest is evaluating the wrong
-   statement form, instead of calling ffebad_start directly.  If ffest
-   is choosing between forms, it will return FALSE, send an EOS/SEMICOLON
-   token through as the next token (if the current one isn't already one
-   of those), and try another possible form.  Otherwise, ffebad_start is
-   called with the argument and TRUE returned.	*/
-
-bool
-ffesta_ffebad_start (ffebad errnum)
-{
-  if (!ffesta_is_inhibited_)
-    {
-      ffebad_start (errnum);
-      return TRUE;
-    }
-
-  if (!ffesta_confirmed_current_)
-    ffesta_current_shutdown_ = TRUE;
-
-  return FALSE;
-}
-
-/* ffesta_first -- Parse the first token in a statement
-
-   return ffesta_first;	 // to lexer.  */
-
-ffelexHandler
-ffesta_first (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeSEMICOLON:
-    case FFELEX_typeEOS:
-      ffesta_tokens[0] = ffelex_token_use (t);
-      if (ffesta_label_token != NULL)
-	{
-	  ffebad_start (FFEBAD_LABEL_WITHOUT_STMT);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_string (ffelex_token_text (ffesta_label_token));
-	  ffebad_here (1, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      ffesta_token_0_ = ffelex_token_use (t);
-      ffesta_first_kw = ffestr_first (t);
-      return (ffelexHandler) ffesta_second_;
-
-    case FFELEX_typeNUMBER:
-      if (ffesta_line_has_semicolons
-	  && !ffe_is_free_form ()
-	  && ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_LABEL_WRONG_PLACE);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_finish ();
-	}
-      if (ffesta_label_token == NULL)
-	{
-	  ffesta_label_token = ffelex_token_use (t);
-	  return (ffelexHandler) ffesta_first;
-	}
-      else
-	{
-	  ffebad_start (FFEBAD_EXTRA_LABEL_DEF);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_string (ffelex_token_text (t));
-	  ffebad_here (1, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_string (ffelex_token_text (ffesta_label_token));
-	  ffebad_finish ();
-
-	  return (ffelexHandler) ffesta_first;
-	}
-
-    default:			/* Invalid first token. */
-      ffesta_tokens[0] = ffelex_token_use (t);
-      ffebad_start (FFEBAD_STMT_BEGINS_BAD);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffesta_init_0 -- Initialize for entire image invocation
-
-   ffesta_init_0();
-
-   Call just once per invocation of the compiler (not once per invocation
-   of the front end).
-
-   Gets memory for the list of possibles once and for all, since this
-   list never gets larger than a certain size (FFESTA_maxPOSSIBLES_)
-   and is not particularly large.  Initializes the array of pointers to
-   this list.  Initializes the executable and nonexecutable lists.  */
-
-void
-ffesta_init_0 (void)
-{
-  ffestaPossible_ ptr;
-  int i;
-
-  ptr = malloc_new_kp (malloc_pool_image (), "FFEST possibles",
-		       FFESTA_maxPOSSIBLES_ * sizeof (*ptr));
-
-  for (i = 0; i < FFESTA_maxPOSSIBLES_; ++i)
-    ffesta_possibles_[i] = ptr++;
-
-  ffesta_possible_execs_.first = ffesta_possible_execs_.last
-    = (ffestaPossible_) &ffesta_possible_execs_.first;
-  ffesta_possible_nonexecs_.first = ffesta_possible_nonexecs_.last
-    = (ffestaPossible_) &ffesta_possible_nonexecs_.first;
-  ffesta_possible_execs_.nil = ffesta_possible_nonexecs_.nil = NULL;
-}
-
-/* ffesta_init_3 -- Initialize for any program unit
-
-   ffesta_init_3();  */
-
-void
-ffesta_init_3 (void)
-{
-  ffesta_output_pool = NULL;	/* May be doing this just before reaching */
-  ffesta_scratch_pool = NULL;	/* ffesta_zero or ffesta_two. */
-  /* NOTE: we let the ffe_terminate_2 action of killing the program_unit pool
-     handle the killing of the output and scratch pools for us, which is why
-     we don't have a terminate_3 action to do so. */
-  ffesta_construct_name = NULL;
-  ffesta_label_token = NULL;
-  ffesta_seen_first_exec = FALSE;
-}
-
-/* ffesta_is_inhibited -- Test whether the current possibility is inhibited
-
-   if (!ffesta_is_inhibited())
-       // implement the statement.
-
-   Just make sure the current possibility has been confirmed.  If anyone
-   really needs to test whether the current possibility is inhibited prior
-   to confirming it, that indicates a need to begin statement processing
-   before it is certain that the given possibility is indeed the statement
-   to be processed.  As of this writing, there does not appear to be such
-   a need.  If there is, then when confirming a statement would normally
-   immediately disable the inhibition (whereas currently we leave the
-   confirmed statement disabled until we've tried the other possibilities,
-   to check for ambiguities), we must check to see if the possibility has
-   already tested for inhibition prior to confirmation and, if so, maintain
-   inhibition until the end of the statement (which may be forced right
-   away) and then rerun the entire statement from the beginning.  Otherwise,
-   initial calls to ffestb functions won't have been made, but subsequent
-   calls (after confirmation) will, which is wrong.  Of course, this all
-   applies only to those statements implemented via multiple calls to
-   ffestb, although if a statement requiring only a single ffestb call
-   tested for inhibition prior to confirmation, it would likely mean that
-   the ffestb call would be completely dropped without this mechanism.	*/
-
-bool
-ffesta_is_inhibited (void)
-{
-  assert (ffesta_confirmed_current_ || ffesta_inhibit_confirmation_);
-  return ffesta_is_inhibited_;
-}
-
-/* ffesta_ffebad_1p -- Issue diagnostic with one source character
-
-   ffelexToken names_token;
-   ffeTokenLength index;
-   ffelexToken next_token;
-   ffesta_ffebad_1p(FFEBAD_SOME_ERROR,names_token,index,next_token);
-
-   Equivalent to "if (ffest_ffebad_start(FFEBAD_SOME_ERROR))" followed by
-   sending one argument, the location of index with names_token, if TRUE is
-   returned.  If index is equal to the length of names_token, meaning it
-   points to the end of the token, then uses the location in next_token
-   (which should be the token sent by the lexer after it sent names_token)
-   instead.  */
-
-void
-ffesta_ffebad_1p (ffebad errnum, ffelexToken names_token, ffeTokenLength index,
-		  ffelexToken next_token)
-{
-  ffewhereLine line;
-  ffewhereColumn col;
-
-  assert (index <= ffelex_token_length (names_token));
-
-  if (ffesta_ffebad_start (errnum))
-    {
-      if (index == ffelex_token_length (names_token))
-	{
-	  assert (next_token != NULL);
-	  line = ffelex_token_where_line (next_token);
-	  col = ffelex_token_where_column (next_token);
-	  ffebad_here (0, line, col);
-	}
-      else
-	{
-	  ffewhere_set_from_track (&line, &col,
-				   ffelex_token_where_line (names_token),
-				   ffelex_token_where_column (names_token),
-				   ffelex_token_wheretrack (names_token),
-				   index);
-	  ffebad_here (0, line, col);
-	  ffewhere_line_kill (line);
-	  ffewhere_column_kill (col);
-	}
-      ffebad_finish ();
-    }
-}
-
-void
-ffesta_ffebad_1sp (ffebad errnum, const char *s, ffelexToken names_token,
-		   ffeTokenLength index, ffelexToken next_token)
-{
-  ffewhereLine line;
-  ffewhereColumn col;
-
-  assert (index <= ffelex_token_length (names_token));
-
-  if (ffesta_ffebad_start (errnum))
-    {
-      ffebad_string (s);
-      if (index == ffelex_token_length (names_token))
-	{
-	  assert (next_token != NULL);
-	  line = ffelex_token_where_line (next_token);
-	  col = ffelex_token_where_column (next_token);
-	  ffebad_here (0, line, col);
-	}
-      else
-	{
-	  ffewhere_set_from_track (&line, &col,
-				   ffelex_token_where_line (names_token),
-				   ffelex_token_where_column (names_token),
-				   ffelex_token_wheretrack (names_token),
-				   index);
-	  ffebad_here (0, line, col);
-	  ffewhere_line_kill (line);
-	  ffewhere_column_kill (col);
-	}
-      ffebad_finish ();
-    }
-}
-
-void
-ffesta_ffebad_1st (ffebad errnum, const char *s, ffelexToken t)
-{
-  if (ffesta_ffebad_start (errnum))
-    {
-      ffebad_string (s);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-}
-
-/* ffesta_ffebad_1t -- Issue diagnostic with one source token
-
-   ffelexToken t;
-   ffesta_ffebad_1t(FFEBAD_SOME_ERROR,t);
-
-   Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by
-   sending one argument, the location of the token t, if TRUE is returned.  */
-
-void
-ffesta_ffebad_1t (ffebad errnum, ffelexToken t)
-{
-  if (ffesta_ffebad_start (errnum))
-    {
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-}
-
-void
-ffesta_ffebad_2st (ffebad errnum, const char *s, ffelexToken t1, ffelexToken t2)
-{
-  if (ffesta_ffebad_start (errnum))
-    {
-      ffebad_string (s);
-      ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1));
-      ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2));
-      ffebad_finish ();
-    }
-}
-
-/* ffesta_ffebad_2t -- Issue diagnostic with two source tokens
-
-   ffelexToken t1, t2;
-   ffesta_ffebad_2t(FFEBAD_SOME_ERROR,t1,t2);
-
-   Equivalent to "if (ffesta_ffebad_start(FFEBAD_SOME_ERROR))" followed by
-   sending two argument, the locations of the tokens t1 and t2, if TRUE is
-   returned.  */
-
-void
-ffesta_ffebad_2t (ffebad errnum, ffelexToken t1, ffelexToken t2)
-{
-  if (ffesta_ffebad_start (errnum))
-    {
-      ffebad_here (0, ffelex_token_where_line (t1), ffelex_token_where_column (t1));
-      ffebad_here (1, ffelex_token_where_line (t2), ffelex_token_where_column (t2));
-      ffebad_finish ();
-    }
-}
-
-ffestaPooldisp
-ffesta_outpooldisp (void)
-{
-  return ffesta_outpooldisp_;
-}
-
-void
-ffesta_set_outpooldisp (ffestaPooldisp d)
-{
-  ffesta_outpooldisp_ = d;
-}
-
-/* Shut down current parsing possibility, but without bothering the
-   user with a diagnostic if we're not inhibited.  */
-
-void
-ffesta_shutdown (void)
-{
-  if (ffesta_is_inhibited_)
-    ffesta_current_shutdown_ = TRUE;
-}
-
-/* ffesta_two -- Deal with the first two tokens after a swallowed statement
-
-   return ffesta_two(first_token,second_token);	 // to lexer.
-
-   Like ffesta_zero, except instead of expecting an EOS or SEMICOLON, it
-   expects the first two tokens of a statement that is part of another
-   statement: the first two tokens of statement in "IF (expr) statement" or
-   "WHERE (expr) statement", in particular.  The first token must be a NAME
-   or NAMES, the second can be basically anything.  The statement type MUST
-   be confirmed by now.
-
-   If we're not inhibited, just handle things as if we were ffesta_zero
-   and saw an EOS just before the two tokens.
-
-   If we're inhibited, set ffesta_current_shutdown_ to shut down the current
-   statement and continue with other possibilities, then (presumably) come
-   back to this one for real when not inhibited.  */
-
-ffelexHandler
-ffesta_two (ffelexToken first, ffelexToken second)
-{
-#if FFESTA_ABORT_ON_CONFIRM_
-  ffelexHandler next;
-#endif
-
-  assert ((ffelex_token_type (first) == FFELEX_typeNAME)
-	  || (ffelex_token_type (first) == FFELEX_typeNAMES));
-  assert (ffesta_tokens[0] != NULL);
-
-  if (ffesta_is_inhibited_)	/* Oh, not really done with statement. */
-    {
-      ffesta_current_shutdown_ = TRUE;
-      /* To catch the EOS on shutdown. */
-      return (ffelexHandler) ffelex_swallow_tokens (second,
-					       (ffelexHandler) ffesta_zero);
-    }
-
-  ffestw_display_state ();
-
-  ffelex_token_kill (ffesta_tokens[0]);
-
-  if (ffesta_output_pool != NULL)
-    {
-      if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
-	malloc_pool_kill (ffesta_output_pool);
-      ffesta_output_pool = NULL;
-    }
-
-  if (ffesta_scratch_pool != NULL)
-    {
-      malloc_pool_kill (ffesta_scratch_pool);
-      ffesta_scratch_pool = NULL;
-    }
-
-  ffesta_reset_possibles_ ();
-  ffesta_confirmed_current_ = FALSE;
-
-  /* What happens here is somewhat interesting.	 We effectively derail the
-     line of handlers for these two tokens, the first two in a statement, by
-     setting a flag to TRUE.  This flag tells ffesta_save_ (or, conceivably,
-     the lexer via ffesta_second_'s case 1:, where it has only one possible
-     kind of statement -- someday this will be more likely, i.e. after
-     confirmation causes an immediate switch to only the one context rather
-     than just setting a flag and running through the remaining possibles to
-     look for ambiguities) that the last two tokens it sent did not reach the
-     truly desired targets (ffest_first and ffesta_second_) since that would
-     otherwise attempt to recursively invoke ffesta_save_ in most cases,
-     while the existing ffesta_save_ was still alive and making use of static
-     (nonrecursive) variables.	Instead, ffesta_save_, upon seeing this flag
-     set TRUE, sets it to FALSE and resubmits the two tokens copied here to
-     ffest_first and, presumably, ffesta_second_, kills them, and returns the
-     handler returned by the handler for the second token.  Thus, even though
-     ffesta_save_ is still (likely to be) recursively invoked, the former
-     invocation is past the use of any static variables possibly changed
-     during the first-two-token invocation of the latter invocation. */
-
-#if FFESTA_ABORT_ON_CONFIRM_
-  /* Shouldn't be in ffesta_save_ at all here. */
-
-  next = (ffelexHandler) ffesta_first (first);
-  return (ffelexHandler) (*next) (second);
-#else
-  ffesta_twotokens_1_ = ffelex_token_use (first);
-  ffesta_twotokens_2_ = ffelex_token_use (second);
-
-  ffesta_is_two_into_statement_ = TRUE;
-  return (ffelexHandler) ffesta_send_two_;	/* Shouldn't get called. */
-#endif
-}
-
-/* ffesta_zero -- Deal with the end of a swallowed statement
-
-   return ffesta_zero;	// to lexer.
-
-   NOTICE that this code is COPIED, largely, into a
-   similar function named ffesta_two that gets invoked in place of
-   _zero_ when the end of the statement happens before EOS or SEMICOLON and
-   to tokens into the next statement have been read (as is the case with the
-   logical-IF and WHERE-stmt statements).  So any changes made here should
-   probably be made in _two_ at the same time.	*/
-
-ffelexHandler
-ffesta_zero (ffelexToken t)
-{
-  assert ((ffelex_token_type (t) == FFELEX_typeEOS)
-	  || (ffelex_token_type (t) == FFELEX_typeSEMICOLON));
-  assert (ffesta_tokens[0] != NULL);
-
-  if (ffesta_is_inhibited_)
-    ffesymbol_retract (TRUE);
-  else
-    ffestw_display_state ();
-
-  /* Do CONTINUE if nothing else.  This is done specifically so that "IF
-     (...) BLAH" causes the same things to happen as if "IF (...) CONTINUE"
-     was done, so that tracking of labels and such works.  (Try a small
-     program like "DO 10 ...", "IF (...) BLAH", "10 CONTINUE", "END".)
-
-     But it turns out that just testing "!ffesta_confirmed_current_"
-     isn't enough, because then typing "GOTO" instead of "BLAH" above
-     doesn't work -- the statement is confirmed (we know the user
-     attempted a GOTO) but ffestc hasn't seen it.  So, instead, just
-     always tell ffestc to do "any" statement it needs to reset.  */
-
-  if (!ffesta_is_inhibited_
-      && ffesta_seen_first_exec)
-    {
-      ffestc_any ();
-    }
-
-  ffelex_token_kill (ffesta_tokens[0]);
-
-  if (ffesta_is_inhibited_)	/* Oh, not really done with statement. */
-    return (ffelexHandler) ffesta_zero;	/* Call me again when done! */
-
-  if (ffesta_output_pool != NULL)
-    {
-      if (ffesta_outpooldisp_ == FFESTA_pooldispDISCARD)
-	malloc_pool_kill (ffesta_output_pool);
-      ffesta_output_pool = NULL;
-    }
-
-  if (ffesta_scratch_pool != NULL)
-    {
-      malloc_pool_kill (ffesta_scratch_pool);
-      ffesta_scratch_pool = NULL;
-    }
-
-  ffesta_reset_possibles_ ();
-  ffesta_confirmed_current_ = FALSE;
-
-  if (ffelex_token_type (t) == FFELEX_typeSEMICOLON)
-    {
-      ffesta_line_has_semicolons = TRUE;
-      if (ffe_is_pedantic_not_90 ())
-	{
-	  ffebad_start (FFEBAD_SEMICOLON);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-    }
-  else
-    ffesta_line_has_semicolons = FALSE;
-
-  if (ffesta_label_token != NULL)
-    {
-      ffelex_token_kill (ffesta_label_token);
-      ffesta_label_token = NULL;
-    }
-
-  if (ffe_is_ffedebug ())
-    {
-      ffestorag_report ();
-    }
-
-  ffelex_set_names (TRUE);
-  return (ffelexHandler) ffesta_first;
-}
diff --git a/gcc/f/sta.h b/gcc/f/sta.h
deleted file mode 100644
index cf41777..0000000
--- a/gcc/f/sta.h
+++ /dev/null
@@ -1,117 +0,0 @@
-/* sta.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      sta.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STA_H
-#define GCC_F_STA_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFESTA_pooldispDISCARD,	/* Default state. */
-    FFESTA_pooldispPRESERVE,	/* Preserve through end of program unit. */
-    FFESTA_pooldisp
-  } ffestaPooldisp;
-
-#define FFESTA_tokensMAX 10	/* Max # tokens in fixed positions. */
-
-/* Typedefs. */
-
-/* Include files needed by this one. */
-
-#include "bad.h"
-#include "lex.h"
-#include "malloc.h"
-#include "str.h"
-#include "symbol.h"
-
-typedef mallocPool ffestaPool;	/* No need for use count yet. */
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-extern ffelexToken ffesta_tokens[FFESTA_tokensMAX];
-extern ffestrFirst ffesta_first_kw;
-extern ffestrSecond ffesta_second_kw;
-extern mallocPool ffesta_output_pool;
-extern mallocPool ffesta_scratch_pool;
-extern ffelexToken ffesta_construct_name;
-extern ffelexToken ffesta_label_token;
-extern bool ffesta_seen_first_exec;
-extern bool ffesta_is_entry_valid;
-extern bool ffesta_line_has_semicolons;
-
-/* Declare functions with prototypes. */
-
-void ffesta_confirmed (void);
-void ffesta_eof (void);
-bool ffesta_ffebad_start (ffebad errnum);
-void ffesta_ffebad_here_current_stmt (ffebadIndex i);
-ffelexHandler ffesta_first (ffelexToken t);
-void ffesta_init_0 (void);
-void ffesta_init_3 (void);
-bool ffesta_is_inhibited (void);
-void ffesta_terminate_0 (void);
-void ffesta_terminate_1 (void);
-void ffesta_terminate_2 (void);
-void ffesta_terminate_3 (void);
-void ffesta_terminate_4 (void);
-void ffesta_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
-void ffesta_shutdown (void);
-ffesymbol ffesta_sym_end_transition (ffesymbol s);
-ffesymbol ffesta_sym_exec_transition (ffesymbol s);
-void ffesta_ffebad_1p (ffebad msg, ffelexToken names_token,
-		       ffeTokenLength index, ffelexToken next_token);
-void ffesta_ffebad_1sp (ffebad msg, const char *s, ffelexToken names_token,
-			ffeTokenLength index, ffelexToken next_token);
-void ffesta_ffebad_1st (ffebad msg, const char *s, ffelexToken t);
-void ffesta_ffebad_1t (ffebad msg, ffelexToken t);
-void ffesta_ffebad_2st (ffebad msg, const char *s, ffelexToken t1, ffelexToken t2);
-void ffesta_ffebad_2t (ffebad msg, ffelexToken t1, ffelexToken t2);
-ffelexHandler ffesta_zero (ffelexToken t);
-ffelexHandler ffesta_two (ffelexToken first, ffelexToken second);
-ffestaPooldisp ffesta_outpooldisp (void);
-void ffesta_set_outpooldisp (ffestaPooldisp d);
-
-/* Define macros. */
-
-#define ffesta_init_1()
-#define ffesta_init_2()
-#define ffesta_init_4()
-#define ffesta_terminate_0()
-#define ffesta_terminate_1()
-#define ffesta_terminate_2()
-#define ffesta_terminate_3()
-#define ffesta_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STA_H */
diff --git a/gcc/f/stb.c b/gcc/f/stb.c
deleted file mode 100644
index 673f96c..0000000
--- a/gcc/f/stb.c
+++ /dev/null
@@ -1,17812 +0,0 @@
-/* stb.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 2002, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      st.c
-
-   Description:
-      Parses the proper form for statements, builds up expression trees for
-      them, but does not actually implement them.  Uses ffebad (primarily via
-      ffesta_ffebad_start) to indicate errors in form.	In many cases, an invalid
-      statement form indicates another possible statement needs to be looked at
-      by ffest.	 In a few cases, a valid statement form might not completely
-      determine the nature of the statement, as in REALFUNCTIONA(B), which is
-      a valid form for either the first statement of a function named A taking
-      an argument named B or for the declaration of a real array named FUNCTIONA
-      with an adjustable size of B.  A similar (though somewhat easier) choice
-      must be made for the statement-function-def vs. assignment forms, as in
-      the case of FOO(A) = A+2.0.
-
-      A given parser consists of one or more state handlers, the first of which
-      is the initial state, and the last of which (for any given input) returns
-      control to a final state handler (ffesta_zero or ffesta_two, explained
-      below).  The functions handling the states for a given parser usually have
-      the same names, differing only in the final number, as in ffestb_foo_
-      (handles the initial state), ffestb_foo_1_, ffestb_foo_2_ (handle
-      subsequent states), although liberties sometimes are taken with the "foo"
-      part either when keywords are clarified into given statements or are
-      transferred into other possible areas.  (For example, the type-name
-      states can hop over to _dummy_ functions when the FUNCTION or RECURSIVE
-      keywords are seen, though this kind of thing is kept to a minimum.)  Only
-      the names without numbers are exported to the rest of ffest; the others
-      are local (static).
-
-      Each initial state is provided with the first token in ffesta_tokens[0],
-      which will be killed upon return to the final state (ffesta_zero or
-      ffelex_swallow_tokens passed through to ffesta_zero), so while it may
-      be changed to another token, a valid token must be left there to be
-      killed.  Also, a "convenient" array of tokens are left in
-      ffesta_tokens[1..FFESTA_tokensMAX].  The initial state of this set of
-      elements is undefined, thus, if tokens are stored here, they must be
-      killed before returning to the final state.  Any parser may also use
-      cross-state local variables by sticking a structure containing storage
-      for those variables in the local union ffestb_local_ (unless the union
-      goes on strike).	Furthermore, parsers that handle more than one first or
-      second tokens (like _varlist_, which handles EXTERNAL, INTENT, INTRINSIC,
-      OPTIONAL,
-      PUBLIC, or PRIVATE, and _endxyz_, which handles ENDBLOCK, ENDBLOCKDATA,
-      ENDDO, ENDIF, and so on) may expect arguments from ffest in the
-      ffest-wide union ffest_args_, the substructure specific to the parser.
-
-      A parser's responsibility is: to call either ffesta_confirmed or
-      ffest_ffebad_start before returning to the final state; to be the only
-      parser that can possibly call ffesta_confirmed for a given statement;
-      to call ffest_ffebad_start immediately upon recognizing a bad token
-      (specifically one that another statement parser might confirm upon);
-      to call ffestc functions only after calling ffesta_confirmed and only
-      when ffesta_is_inhibited returns FALSE; and to call ffesta_is_inhibited
-      only after calling ffesta_confirmed.  Confirm as early as reasonably
-      possible, even when only one ffestc function is called for the statement
-      later on, because early confirmation can enhance the error-reporting
-      capabilities if a subsequent error is detected and this parser isn't
-      the first possibility for the statement.
-
-      To assist the parser, functions like ffesta_ffebad_1t and _1p_ have
-      been provided to make use of ffest_ffebad_start fairly easy.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stb.h"
-#include "bad.h"
-#include "expr.h"
-#include "lex.h"
-#include "malloc.h"
-#include "src.h"
-#include "sta.h"
-#include "stc.h"
-#include "stp.h"
-#include "str.h"
-
-/* Externals defined here. */
-
-struct _ffestb_args_ ffestb_args;
-
-/* Simple definitions and enumerations. */
-
-#define FFESTB_KILL_EASY_ 1	/* 1 for only one _subr_kill_xyz_ fn. */
-
-/* Internal typedefs. */
-
-union ffestb_subrargs_u_
-  {
-    struct
-      {
-	ffesttTokenList labels;	/* Input arg, must not be NULL. */
-	ffelexHandler handler;	/* Input arg, call me when done. */
-	bool ok;		/* Output arg, TRUE if list ended in
-				   CLOSE_PAREN. */
-      }
-    label_list;
-    struct
-      {
-	ffesttDimList dims;	/* Input arg, must not be NULL. */
-	ffelexHandler handler;	/* Input arg, call me when done. */
-	mallocPool pool;	/* Pool to allocate into. */
-	bool ok;		/* Output arg, TRUE if list ended in
-				   CLOSE_PAREN. */
-	ffeexprContext ctx;	/* DIMLIST or DIMLISTCOMMON. */
-#ifdef FFECOM_dimensionsMAX
-	int ndims;		/* For backends that really can't have
-				   infinite dims. */
-#endif
-      }
-    dim_list;
-    struct
-      {
-	ffesttTokenList args;	/* Input arg, must not be NULL. */
-	ffelexHandler handler;	/* Input arg, call me when done. */
-	ffelexToken close_paren;/* Output arg if ok, CLOSE_PAREN token. */
-	bool is_subr;		/* Input arg, TRUE if list in subr-def
-				   context. */
-	bool ok;		/* Output arg, TRUE if list ended in
-				   CLOSE_PAREN. */
-	bool names;		/* Do ffelex_set_names(TRUE) before return. */
-      }
-    name_list;
-  };
-
-union ffestb_local_u_
-  {
-    struct
-      {
-	ffebld expr;
-      }
-    call_stmt;
-    struct
-      {
-	ffebld expr;
-      }
-    go_to;
-    struct
-      {
-	ffebld dest;
-	bool vxtparam;		/* If assignment might really be VXT
-				   PARAMETER stmt. */
-      }
-    let;
-    struct
-      {
-	ffebld expr;
-      }
-    if_stmt;
-    struct
-      {
-	ffebld expr;
-      }
-    else_stmt;
-    struct
-      {
-	ffebld expr;
-      }
-    dowhile;
-    struct
-      {
-	ffebld var;
-	ffebld start;
-	ffebld end;
-      }
-    do_stmt;
-    struct
-      {
-	bool is_cblock;
-      }
-    R522;
-    struct
-      {
-	ffebld expr;
-	bool started;
-      }
-    parameter;
-    struct
-      {
-	ffesttExprList exprs;
-	bool started;
-      }
-    equivalence;
-    struct
-      {
-	ffebld expr;
-	bool started;
-      }
-    data;
-    struct
-      {
-	ffestrOther kw;
-      }
-    varlist;
-    struct
-      {
-	ffelexHandler next;
-      }
-    construct;
-    struct
-      {
-	ffesttFormatList f;
-	ffestpFormatType current;	/* What we're currently working on. */
-	ffelexToken t;		/* Token of what we're currently working on. */
-	ffesttFormatValue pre;
-	ffesttFormatValue post;
-	ffesttFormatValue dot;
-	ffesttFormatValue exp;
-	bool sign;		/* _3_, pos/neg; elsewhere, signed/unsigned. */
-	bool complained;	/* If run-time expr seen in nonexec context. */
-      }
-    format;
-    struct
-      {
-	ffebld expr;
-      }
-    selectcase;
-    struct
-      {
-	ffesttCaseList cases;
-      }
-    case_stmt;
-    struct
-      {
-	bool is_cblock;
-      }
-    V014;
-    struct
-      {
-	ffestpBeruIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    beru;
-    struct
-      {
-	ffestpCloseIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    close;
-    struct
-      {
-	ffestpDeleteIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    delete;
-    struct
-      {
-	ffestpDeleteIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    find;
-    struct
-      {
-	ffestpInquireIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-	bool may_be_iolength;
-      }
-    inquire;
-    struct
-      {
-	ffestpOpenIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    open;
-    struct
-      {
-	ffestpReadIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    read;
-    struct
-      {
-	ffestpRewriteIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    rewrite;
-    struct
-      {
-	ffestpWriteIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    vxtcode;
-    struct
-      {
-	ffestpWriteIx ix;
-	bool label;
-	bool left;
-	ffeexprContext context;
-      }
-    write;
-    struct
-      {
-	bool started;
-      }
-    common;
-    struct
-      {
-	bool started;
-      }
-    dimension;
-    struct
-      {
-	bool started;
-      }
-    dimlist;
-    struct
-      {
-	const char *badname;
-	ffestrFirst first_kw;
-	bool is_subr;
-      }
-    dummy;
-    struct
-      {
-	ffebld kind;		/* Kind type parameter, if any. */
-	ffelexToken kindt;	/* Kind type first token, if any. */
-	ffebld len;		/* Length type parameter, if any. */
-	ffelexToken lent;	/* Length type parameter, if any. */
-	ffelexHandler handler;
-	ffelexToken recursive;
-	ffebld expr;
-	ffesttTokenList toklist;/* For ambiguity resolution. */
-	ffesttImpList imps;	/* List of IMPLICIT letters. */
-	ffelexHandler imp_handler;	/* Call if paren list wasn't letters. */
-	const char *badname;
-	ffestrOther kw;		/* INTENT(IN/OUT/INOUT). */
-	ffestpType type;
-	bool parameter;		/* If PARAMETER attribute seen (governs =expr
-				   context). */
-	bool coloncolon;	/* If COLONCOLON seen (allows =expr). */
-	bool aster_after;	/* "*" seen after, not before,
-				   [RECURSIVE]FUNCTIONxyz. */
-	bool empty;		/* Ambig function dummy arg list empty so
-				   far? */
-	bool imp_started;	/* Started IMPLICIT statement already. */
-	bool imp_seen_comma;	/* TRUE if next COMMA within parens means not
-				   R541. */
-      }
-    decl;
-    struct
-      {
-	bool started;
-      }
-    vxtparam;
-  };				/* Merge with the one in ffestb later. */
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-static union ffestb_subrargs_u_ ffestb_subrargs_;
-static union ffestb_local_u_ ffestb_local_;
-
-/* Static functions (internal). */
-
-static void ffestb_subr_ambig_to_ents_ (void);
-static ffelexHandler ffestb_subr_ambig_nope_ (ffelexToken t);
-static ffelexHandler ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr,
-					   ffelexToken t);
-static ffelexHandler ffestb_subr_dimlist_1_ (ffelexToken ft, ffebld expr,
-					     ffelexToken t);
-static ffelexHandler ffestb_subr_dimlist_2_ (ffelexToken ft, ffebld expr,
-					     ffelexToken t);
-static ffelexHandler ffestb_subr_name_list_ (ffelexToken t);
-static ffelexHandler ffestb_subr_name_list_1_ (ffelexToken t);
-static void ffestb_subr_R1001_append_p_ (void);
-static ffelexHandler ffestb_decl_kindparam_ (ffelexToken t);
-static ffelexHandler ffestb_decl_kindparam_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr,
-					       ffelexToken t);
-static ffelexHandler ffestb_decl_starkind_ (ffelexToken t);
-static ffelexHandler ffestb_decl_starlen_ (ffelexToken t);
-static ffelexHandler ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr,
-					     ffelexToken t);
-static ffelexHandler ffestb_decl_typeparams_ (ffelexToken t);
-static ffelexHandler ffestb_decl_typeparams_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr,
-						ffelexToken t);
-static ffelexHandler ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr,
-						ffelexToken t);
-static ffelexHandler ffestb_subr_label_list_ (ffelexToken t);
-static ffelexHandler ffestb_subr_label_list_1_ (ffelexToken t);
-static ffelexHandler ffestb_do1_ (ffelexToken t);
-static ffelexHandler ffestb_do2_ (ffelexToken t);
-static ffelexHandler ffestb_do3_ (ffelexToken t);
-static ffelexHandler ffestb_do4_ (ffelexToken ft, ffebld expr,
-				  ffelexToken t);
-static ffelexHandler ffestb_do5_ (ffelexToken t);
-static ffelexHandler ffestb_do6_ (ffelexToken ft, ffebld expr,
-				  ffelexToken t);
-static ffelexHandler ffestb_do7_ (ffelexToken ft, ffebld expr,
-				  ffelexToken t);
-static ffelexHandler ffestb_do8_ (ffelexToken ft, ffebld expr,
-				  ffelexToken t);
-static ffelexHandler ffestb_do9_ (ffelexToken ft, ffebld expr,
-				  ffelexToken t);
-static ffelexHandler ffestb_else1_ (ffelexToken t);
-static ffelexHandler ffestb_else2_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_else3_ (ffelexToken t);
-static ffelexHandler ffestb_else4_ (ffelexToken t);
-static ffelexHandler ffestb_else5_ (ffelexToken t);
-static ffelexHandler ffestb_end1_ (ffelexToken t);
-static ffelexHandler ffestb_end2_ (ffelexToken t);
-static ffelexHandler ffestb_end3_ (ffelexToken t);
-static ffelexHandler ffestb_goto1_ (ffelexToken t);
-static ffelexHandler ffestb_goto2_ (ffelexToken t);
-static ffelexHandler ffestb_goto3_ (ffelexToken t);
-static ffelexHandler ffestb_goto4_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_goto5_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_goto6_ (ffelexToken t);
-static ffelexHandler ffestb_goto7_ (ffelexToken t);
-static ffelexHandler ffestb_halt1_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_if1_ (ffelexToken ft, ffebld expr,
-				  ffelexToken t);
-static ffelexHandler ffestb_if2_ (ffelexToken t);
-static ffelexHandler ffestb_if3_ (ffelexToken t);
-static ffelexHandler ffestb_let1_ (ffelexToken ft, ffebld expr,
-				   ffelexToken t);
-static ffelexHandler ffestb_let2_ (ffelexToken ft, ffebld expr,
-				   ffelexToken t);
-static ffelexHandler ffestb_varlist5_ (ffelexToken t);
-static ffelexHandler ffestb_varlist6_ (ffelexToken t);
-static ffelexHandler ffestb_R5221_ (ffelexToken t);
-static ffelexHandler ffestb_R5222_ (ffelexToken t);
-static ffelexHandler ffestb_R5223_ (ffelexToken t);
-static ffelexHandler ffestb_R5224_ (ffelexToken t);
-static ffelexHandler ffestb_R5281_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5282_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5283_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5284_ (ffelexToken t);
-static ffelexHandler ffestb_R5371_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5372_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5373_ (ffelexToken t);
-static ffelexHandler ffestb_R5421_ (ffelexToken t);
-static ffelexHandler ffestb_R5422_ (ffelexToken t);
-static ffelexHandler ffestb_R5423_ (ffelexToken t);
-static ffelexHandler ffestb_R5424_ (ffelexToken t);
-static ffelexHandler ffestb_R5425_ (ffelexToken t);
-static ffelexHandler ffestb_R5441_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5442_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R5443_ (ffelexToken t);
-static ffelexHandler ffestb_R5444_ (ffelexToken t);
-static ffelexHandler ffestb_R8341_ (ffelexToken t);
-static ffelexHandler ffestb_R8351_ (ffelexToken t);
-static ffelexHandler ffestb_R8381_ (ffelexToken t);
-static ffelexHandler ffestb_R8382_ (ffelexToken t);
-static ffelexHandler ffestb_R8383_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R8401_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R8402_ (ffelexToken t);
-static ffelexHandler ffestb_R8403_ (ffelexToken t);
-static ffelexHandler ffestb_R8404_ (ffelexToken t);
-static ffelexHandler ffestb_R8405_ (ffelexToken t);
-static ffelexHandler ffestb_R8406_ (ffelexToken t);
-static ffelexHandler ffestb_R8407_ (ffelexToken t);
-static ffelexHandler ffestb_R11021_ (ffelexToken t);
-static ffelexHandler ffestb_R1111_1_ (ffelexToken t);
-static ffelexHandler ffestb_R1111_2_ (ffelexToken t);
-static ffelexHandler ffestb_R12121_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_R12271_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_construct1_ (ffelexToken t);
-static ffelexHandler ffestb_construct2_ (ffelexToken t);
-static ffelexHandler ffestb_R8091_ (ffelexToken t);
-static ffelexHandler ffestb_R8092_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R8093_ (ffelexToken t);
-static ffelexHandler ffestb_R8101_ (ffelexToken t);
-static ffelexHandler ffestb_R8102_ (ffelexToken t);
-static ffelexHandler ffestb_R8103_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R8104_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R10011_ (ffelexToken t);
-static ffelexHandler ffestb_R10012_ (ffelexToken t);
-static ffelexHandler ffestb_R10013_ (ffelexToken t);
-static ffelexHandler ffestb_R10014_ (ffelexToken t);
-static ffelexHandler ffestb_R10015_ (ffelexToken t);
-static ffelexHandler ffestb_R10016_ (ffelexToken t);
-static ffelexHandler ffestb_R10017_ (ffelexToken t);
-static ffelexHandler ffestb_R10018_ (ffelexToken t);
-static ffelexHandler ffestb_R10019_ (ffelexToken t);
-static ffelexHandler ffestb_R100110_ (ffelexToken t);
-static ffelexHandler ffestb_R100111_ (ffelexToken t);
-static ffelexHandler ffestb_R100112_ (ffelexToken t);
-static ffelexHandler ffestb_R100113_ (ffelexToken t);
-static ffelexHandler ffestb_R100114_ (ffelexToken t);
-static ffelexHandler ffestb_R100115_ (ffelexToken ft, ffebld expr,
-				      ffelexToken t);
-static ffelexHandler ffestb_R100116_ (ffelexToken ft, ffebld expr,
-				      ffelexToken t);
-static ffelexHandler ffestb_R100117_ (ffelexToken ft, ffebld expr,
-				      ffelexToken t);
-static ffelexHandler ffestb_R100118_ (ffelexToken ft, ffebld expr,
-				      ffelexToken t);
-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 FFESTB_KILL_EASY_
-static void ffestb_subr_kill_easy_ (ffestpInquireIx max);
-#else
-static void ffestb_subr_kill_accept_ (void);
-static void ffestb_subr_kill_beru_ (void);
-static void ffestb_subr_kill_close_ (void);
-static void ffestb_subr_kill_delete_ (void);
-static void ffestb_subr_kill_find_ (void);	/* Not written yet. */
-static void ffestb_subr_kill_inquire_ (void);
-static void ffestb_subr_kill_open_ (void);
-static void ffestb_subr_kill_print_ (void);
-static void ffestb_subr_kill_read_ (void);
-static void ffestb_subr_kill_rewrite_ (void);
-static void ffestb_subr_kill_type_ (void);
-static void ffestb_subr_kill_vxtcode_ (void);	/* Not written yet. */
-static void ffestb_subr_kill_write_ (void);
-#endif
-static ffelexHandler ffestb_beru1_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_beru2_ (ffelexToken t);
-static ffelexHandler ffestb_beru3_ (ffelexToken t);
-static ffelexHandler ffestb_beru4_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_beru5_ (ffelexToken t);
-static ffelexHandler ffestb_beru6_ (ffelexToken t);
-static ffelexHandler ffestb_beru7_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_beru8_ (ffelexToken t);
-static ffelexHandler ffestb_beru9_ (ffelexToken t);
-static ffelexHandler ffestb_beru10_ (ffelexToken t);
-static ffelexHandler ffestb_R9041_ (ffelexToken t);
-static ffelexHandler ffestb_R9042_ (ffelexToken t);
-static ffelexHandler ffestb_R9043_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9044_ (ffelexToken t);
-static ffelexHandler ffestb_R9045_ (ffelexToken t);
-static ffelexHandler ffestb_R9046_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9047_ (ffelexToken t);
-static ffelexHandler ffestb_R9048_ (ffelexToken t);
-static ffelexHandler ffestb_R9049_ (ffelexToken t);
-static ffelexHandler ffestb_R9071_ (ffelexToken t);
-static ffelexHandler ffestb_R9072_ (ffelexToken t);
-static ffelexHandler ffestb_R9073_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9074_ (ffelexToken t);
-static ffelexHandler ffestb_R9075_ (ffelexToken t);
-static ffelexHandler ffestb_R9076_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9077_ (ffelexToken t);
-static ffelexHandler ffestb_R9078_ (ffelexToken t);
-static ffelexHandler ffestb_R9079_ (ffelexToken t);
-static ffelexHandler ffestb_R9091_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9092_ (ffelexToken t);
-static ffelexHandler ffestb_R9093_ (ffelexToken t);
-static ffelexHandler ffestb_R9094_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9095_ (ffelexToken t);
-static ffelexHandler ffestb_R9096_ (ffelexToken t);
-static ffelexHandler ffestb_R9097_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9098_ (ffelexToken t);
-static ffelexHandler ffestb_R9099_ (ffelexToken t);
-static ffelexHandler ffestb_R90910_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_R90911_ (ffelexToken t);
-static ffelexHandler ffestb_R90912_ (ffelexToken t);
-static ffelexHandler ffestb_R90913_ (ffelexToken t);
-static ffelexHandler ffestb_R90914_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_R90915_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_R9101_ (ffelexToken t);
-static ffelexHandler ffestb_R9102_ (ffelexToken t);
-static ffelexHandler ffestb_R9103_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9104_ (ffelexToken t);
-static ffelexHandler ffestb_R9105_ (ffelexToken t);
-static ffelexHandler ffestb_R9106_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9107_ (ffelexToken t);
-static ffelexHandler ffestb_R9108_ (ffelexToken t);
-static ffelexHandler ffestb_R9109_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R91010_ (ffelexToken t);
-static ffelexHandler ffestb_R91011_ (ffelexToken t);
-static ffelexHandler ffestb_R91012_ (ffelexToken t);
-static ffelexHandler ffestb_R91013_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_R91014_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_R9111_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9112_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9231_ (ffelexToken t);
-static ffelexHandler ffestb_R9232_ (ffelexToken t);
-static ffelexHandler ffestb_R9233_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9234_ (ffelexToken t);
-static ffelexHandler ffestb_R9235_ (ffelexToken t);
-static ffelexHandler ffestb_R9236_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_R9237_ (ffelexToken t);
-static ffelexHandler ffestb_R9238_ (ffelexToken t);
-static ffelexHandler ffestb_R9239_ (ffelexToken t);
-static ffelexHandler ffestb_R92310_ (ffelexToken t);
-static ffelexHandler ffestb_R92311_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_V0201_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_V0202_ (ffelexToken ft, ffebld expr,
-				    ffelexToken t);
-static ffelexHandler ffestb_dummy1_ (ffelexToken t);
-static ffelexHandler ffestb_dummy2_ (ffelexToken t);
-static ffelexHandler ffestb_R5241_ (ffelexToken t);
-static ffelexHandler ffestb_R5242_ (ffelexToken t);
-static ffelexHandler ffestb_R5243_ (ffelexToken t);
-static ffelexHandler ffestb_R5244_ (ffelexToken t);
-static ffelexHandler ffestb_R5471_ (ffelexToken t);
-static ffelexHandler ffestb_R5472_ (ffelexToken t);
-static ffelexHandler ffestb_R5473_ (ffelexToken t);
-static ffelexHandler ffestb_R5474_ (ffelexToken t);
-static ffelexHandler ffestb_R5475_ (ffelexToken t);
-static ffelexHandler ffestb_R5476_ (ffelexToken t);
-static ffelexHandler ffestb_R5477_ (ffelexToken t);
-static ffelexHandler ffestb_R12291_ (ffelexToken t);
-static ffelexHandler ffestb_R12292_ (ffelexToken ft, ffebld expr,
-				     ffelexToken t);
-static ffelexHandler ffestb_decl_chartype1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrs_7_ (ffelexToken t);
-static ffelexHandler ffestb_decl_attrsp_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-static ffelexHandler ffestb_decl_ents_7_ (ffelexToken t);
-static ffelexHandler ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-static ffelexHandler ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr,
-					  ffelexToken t);
-static ffelexHandler ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr,
-					   ffelexToken t);
-static ffelexHandler ffestb_decl_ents_11_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr,
-					   ffelexToken t);
-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);
-static ffelexHandler ffestb_decl_funcname_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr,
-					      ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_funcname_5_ (ffelexToken t);
-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);
-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);
-static ffelexHandler ffestb_decl_R5394_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R5395_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539letters_5_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_1_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_2_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_3_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_4_ (ffelexToken t);
-static ffelexHandler ffestb_decl_R539maybe_5_ (ffelexToken t);
-
-/* Internal macros. */
-
-#if FFESTB_KILL_EASY_
-#define ffestb_subr_kill_accept_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_acceptix)
-#define ffestb_subr_kill_beru_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_beruix)
-#define ffestb_subr_kill_close_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_closeix)
-#define ffestb_subr_kill_delete_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_deleteix)
-#define ffestb_subr_kill_find_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_findix)
-#define ffestb_subr_kill_inquire_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_inquireix)
-#define ffestb_subr_kill_open_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_openix)
-#define ffestb_subr_kill_print_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_printix)
-#define ffestb_subr_kill_read_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_readix)
-#define ffestb_subr_kill_rewrite_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_rewriteix)
-#define ffestb_subr_kill_type_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_typeix)
-#define ffestb_subr_kill_vxtcode_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
-#define ffestb_subr_kill_write_() \
-      ffestb_subr_kill_easy_((ffestpInquireIx) FFESTP_writeix)
-#endif
-
-/* ffestb_subr_ambig_nope_ -- Cleans up and aborts ambig w/o confirming
-
-   ffestb_subr_ambig_nope_();
-
-   Switch from ambiguity handling in _entsp_ functions to handling entities
-   in _ents_ (perform housekeeping tasks).  */
-
-static ffelexHandler
-ffestb_subr_ambig_nope_ (ffelexToken t)
-{
-  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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_subr_ambig_to_ents_ -- Switches from ambiguity to entity decl
-
-   ffestb_subr_ambig_to_ents_();
-
-   Switch from ambiguity handling in _entsp_ functions to handling entities
-   in _ents_ (perform housekeeping tasks).  */
-
-static void
-ffestb_subr_ambig_to_ents_ (void)
-{
-  ffelexToken nt;
-
-  nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffesta_tokens[1] = nt;
-  if (ffestb_local_.decl.recursive != NULL)
-    ffelex_token_kill (ffestb_local_.decl.recursive);
-  if (!ffestb_local_.decl.aster_after)
-    {
-      if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
-	{
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			  ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
-			   ffestb_local_.decl.len, ffestb_local_.decl.lent);
-	  if (ffestb_local_.decl.kindt != NULL)
-	    {
-	      ffelex_token_kill (ffestb_local_.decl.kindt);
-	      ffestb_local_.decl.kind = NULL;
-	      ffestb_local_.decl.kindt = NULL;
-	    }
-	  if (ffestb_local_.decl.lent != NULL)
-	    {
-	      ffelex_token_kill (ffestb_local_.decl.lent);
-	      ffestb_local_.decl.len = NULL;
-	      ffestb_local_.decl.lent = NULL;
-	    }
-	}
-      else
-	{
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-		    ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL,
-			       NULL);
-	  if (ffestb_local_.decl.kindt != NULL)
-	    {
-	      ffelex_token_kill (ffestb_local_.decl.kindt);
-	      ffestb_local_.decl.kind = NULL;
-	      ffestb_local_.decl.kindt = NULL;
-	    }
-	}
-      return;
-    }
-  if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
-    {
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-	     ffestb_local_.decl.kind, ffestb_local_.decl.kindt, NULL, NULL);
-      if (ffestb_local_.decl.kindt != NULL)
-	{
-	  ffelex_token_kill (ffestb_local_.decl.kindt);
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	}
-    }
-  else if (!ffesta_is_inhibited ())
-    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-		       NULL, NULL, NULL, NULL);
-  /* NAME/NAMES token already in ffesta_tokens[1]. */
-}
-
-/* ffestb_subr_dimlist_ -- OPEN_PAREN expr
-
-   (ffestb_subr_dimlist_)  // to expression handler
-
-   Deal with a dimension list.
-
-   19-Dec-90  JCB  1.1
-      Detect too many dimensions if backend wants it.  */
-
-static ffelexHandler
-ffestb_subr_dimlist_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-#ifdef FFECOM_dimensionsMAX
-      if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
-	{
-	  ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
-	  ffestb_subrargs_.dim_list.ok = TRUE;	/* Not a parse error, really. */
-	  return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-	}
-#endif
-      ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
-			     ffelex_token_use (t));
-      ffestb_subrargs_.dim_list.ok = TRUE;
-      return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-
-    case FFELEX_typeCOMMA:
-      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
-	break;
-#ifdef FFECOM_dimensionsMAX
-      if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
-	{
-	  ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
-	  return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
-					      ffestb_subrargs_.dim_list.ctx,
-				  (ffeexprCallback) ffestb_subr_dimlist_2_);
-	}
-#endif
-      ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, NULL, expr,
-			     ffelex_token_use (t));
-      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
-					  ffestb_subrargs_.dim_list.ctx,
-				    (ffeexprCallback) ffestb_subr_dimlist_);
-
-    case FFELEX_typeCOLON:
-      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
-	break;
-#ifdef FFECOM_dimensionsMAX
-      if (ffestb_subrargs_.dim_list.ndims++ == FFECOM_dimensionsMAX)
-	{
-	  ffesta_ffebad_1t (FFEBAD_TOO_MANY_DIMS, ft);
-	  return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
-					      ffestb_subrargs_.dim_list.ctx,
-				  (ffeexprCallback) ffestb_subr_dimlist_2_);
-	}
-#endif
-      ffestt_dimlist_append (ffestb_subrargs_.dim_list.dims, expr, NULL,
-			     ffelex_token_use (t));	/* NULL second expr for
-							   now, just plug in. */
-      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
-					  ffestb_subrargs_.dim_list.ctx,
-				  (ffeexprCallback) ffestb_subr_dimlist_1_);
-
-    default:
-      break;
-    }
-
-  ffestb_subrargs_.dim_list.ok = FALSE;
-  return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
-}
-
-/* ffestb_subr_dimlist_1_ -- OPEN_PAREN expr COLON expr
-
-   (ffestb_subr_dimlist_1_)  // to expression handler
-
-   Get the upper bound.	 */
-
-static ffelexHandler
-ffestb_subr_dimlist_1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_subrargs_.dim_list.dims->previous->upper = expr;
-      ffestb_subrargs_.dim_list.ok = TRUE;
-      return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-
-    case FFELEX_typeCOMMA:
-      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
-	break;
-      ffestb_subrargs_.dim_list.dims->previous->upper = expr;
-      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
-      ffestb_subrargs_.dim_list.ctx, (ffeexprCallback) ffestb_subr_dimlist_);
-
-    default:
-      break;
-    }
-
-  ffestb_subrargs_.dim_list.ok = FALSE;
-  return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
-}
-
-/* ffestb_subr_dimlist_2_ -- OPEN_PAREN too-many-dim-exprs
-
-   (ffestb_subr_dimlist_2_)  // to expression handler
-
-   Get the upper bound.	 */
-
-static ffelexHandler
-ffestb_subr_dimlist_2_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_subrargs_.dim_list.ok = TRUE;	/* Not a parse error, really. */
-      return (ffelexHandler) ffestb_subrargs_.dim_list.handler;
-
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLON:
-      if ((expr != NULL) && (ffebld_op (expr) == FFEBLD_opSTAR))
-	break;
-      return (ffelexHandler) ffeexpr_rhs (ffestb_subrargs_.dim_list.pool,
-					  ffestb_subrargs_.dim_list.ctx,
-				  (ffeexprCallback) ffestb_subr_dimlist_2_);
-
-    default:
-      break;
-    }
-
-  ffestb_subrargs_.dim_list.ok = FALSE;
-  return (ffelexHandler) ffestb_subrargs_.dim_list.handler (t);
-}
-
-/* ffestb_subr_name_list_ -- Collect a list of name args and close-paren
-
-   return ffestb_subr_name_list_;  // to lexer after seeing OPEN_PAREN
-
-   This implements R1224 in the Fortran 90 spec.  The arg list may be
-   empty, or be a comma-separated list (an optional trailing comma currently
-   results in a warning but no other effect) of arguments.  For functions,
-   however, "*" is invalid (we implement dummy-arg-name, rather than R1224
-   dummy-arg, which itself is either dummy-arg-name or "*").  */
-
-static ffelexHandler
-ffestb_subr_name_list_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (ffestt_tokenlist_count (ffestb_subrargs_.name_list.args) != 0)
-	{			/* Trailing comma, warn. */
-	  ffebad_start (FFEBAD_TRAILING_COMMA);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      ffestb_subrargs_.name_list.ok = TRUE;
-      ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
-      if (ffestb_subrargs_.name_list.names)
-	ffelex_set_names (TRUE);
-      return (ffelexHandler) ffestb_subrargs_.name_list.handler;
-
-    case FFELEX_typeASTERISK:
-      if (!ffestb_subrargs_.name_list.is_subr)
-	break;
-
-    case FFELEX_typeNAME:
-      ffestt_tokenlist_append (ffestb_subrargs_.name_list.args,
-			       ffelex_token_use (t));
-      return (ffelexHandler) ffestb_subr_name_list_1_;
-
-    default:
-      break;
-    }
-
-  ffestb_subrargs_.name_list.ok = FALSE;
-  ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
-  if (ffestb_subrargs_.name_list.names)
-    ffelex_set_names (TRUE);
-  return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
-}
-
-/* ffestb_subr_name_list_1_ -- NAME or ASTERISK
-
-   return ffestb_subr_name_list_1_;  // to lexer
-
-   The next token must be COMMA or CLOSE_PAREN, either way go to original
-   state, but only after adding the appropriate name list item.	 */
-
-static ffelexHandler
-ffestb_subr_name_list_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_subr_name_list_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_subrargs_.name_list.ok = TRUE;
-      ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
-      if (ffestb_subrargs_.name_list.names)
-	ffelex_set_names (TRUE);
-      return (ffelexHandler) ffestb_subrargs_.name_list.handler;
-
-    default:
-      ffestb_subrargs_.name_list.ok = FALSE;
-      ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
-      if (ffestb_subrargs_.name_list.names)
-	ffelex_set_names (TRUE);
-      return (ffelexHandler) (*ffestb_subrargs_.name_list.handler) (t);
-    }
-}
-
-static void
-ffestb_subr_R1001_append_p_ (void)
-{
-  ffesttFormatList f;
-
-  if (!ffestb_local_.format.pre.present)
-    {
-      ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_P_SPEC, ffestb_local_.format.t);
-      ffelex_token_kill (ffestb_local_.format.t);
-      return;
-    }
-
-  f = ffestt_formatlist_append (ffestb_local_.format.f);
-  f->type = FFESTP_formattypeP;
-  f->t = ffestb_local_.format.t;
-  f->u.R1010.val = ffestb_local_.format.pre;
-}
-
-/* ffestb_decl_kindparam_ -- "type" OPEN_PAREN
-
-   return ffestb_decl_kindparam_;  // to lexer
-
-   Handle "[KIND=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_kindparam_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_kindparam_1_;
-
-    default:
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-					     FFEEXPR_contextKINDTYPE,
-			       (ffeexprCallback) ffestb_decl_kindparam_2_)))
-	(t);
-    }
-}
-
-/* ffestb_decl_kindparam_1_ -- "type" OPEN_PAREN NAME
-
-   return ffestb_decl_kindparam_1_;  // to lexer
-
-   Handle "[KIND=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_kindparam_1_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestr_other (ffesta_tokens[1]) != FFESTR_otherKIND)
-	break;
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-       FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_);
-
-    default:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-      FFEEXPR_contextKINDTYPE, (ffeexprCallback) ffestb_decl_kindparam_2_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-
-  if (ffestb_local_.decl.recursive != NULL)
-    ffelex_token_kill (ffestb_local_.decl.recursive);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-		     ffestb_local_.decl.badname,
-		     ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_kindparam_2_ -- "type" OPEN_PAREN ["KIND="] expr
-
-   (ffestb_decl_kindparam_2_)  // to expression handler
-
-   Handle "[KIND=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_kindparam_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_local_.decl.kind = expr;
-      ffestb_local_.decl.kindt = ffelex_token_use (ft);
-      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);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-		    ffestb_local_.decl.badname,
-		    t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_starkind_ -- "type" ASTERISK
-
-   return ffestb_decl_starkind_;  // to lexer
-
-   Handle NUMBER.  */
-
-static ffelexHandler
-ffestb_decl_starkind_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestb_local_.decl.kindt = ffelex_token_use (t);
-      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);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-		    ffestb_local_.decl.badname,
-		    t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_starlen_ -- "CHARACTER" ASTERISK
-
-   return ffestb_decl_starlen_;	 // to lexer
-
-   Handle NUMBER.  */
-
-static ffelexHandler
-ffestb_decl_starlen_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = ffelex_token_use (t);
-      ffelex_set_names (TRUE);
-      return (ffelexHandler) ffestb_local_.decl.handler;
-
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  FFEEXPR_contextCHARACTERSIZE,
-				  (ffeexprCallback) ffestb_decl_starlen_1_);
-
-    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_starlen_1_ -- "CHARACTER" ASTERISK OPEN_PAREN expr
-
-   (ffestb_decl_starlen_1_)  // to expression handler
-
-   Handle CLOSE_PAREN.	*/
-
-static ffelexHandler
-ffestb_decl_starlen_1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestb_local_.decl.len = expr;
-      ffestb_local_.decl.lent = ffelex_token_use (ft);
-      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);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-		    ffestb_local_.decl.badname,
-		    t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_ -- "CHARACTER" OPEN_PAREN
-
-   return ffestb_decl_typeparams_;  // to lexer
-
-   Handle "[KIND=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_typeparams_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_typeparams_1_;
-
-    default:
-      if (ffestb_local_.decl.lent == NULL)
-	return (ffelexHandler) (*((ffelexHandler)
-				  ffeexpr_rhs (ffesta_output_pool,
-					       FFEEXPR_contextCHARACTERSIZE,
-			      (ffeexprCallback) ffestb_decl_typeparams_2_)))
-	  (t);
-      if (ffestb_local_.decl.kindt != NULL)
-	break;
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-					     FFEEXPR_contextKINDTYPE,
-			      (ffeexprCallback) ffestb_decl_typeparams_3_)))
-	(t);
-    }
-
-  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,
-		    ffestb_local_.decl.badname,
-		    t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_1_ -- "CHARACTER" OPEN_PAREN NAME
-
-   return ffestb_decl_typeparams_1_;  // to lexer
-
-   Handle "[KIND=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_typeparams_1_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      switch (ffestr_other (ffesta_tokens[1]))
-	{
-	case FFESTR_otherLEN:
-	  if (ffestb_local_.decl.lent != NULL)
-	    break;
-	  ffelex_token_kill (ffesta_tokens[1]);
-	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					      FFEEXPR_contextCHARACTERSIZE,
-			       (ffeexprCallback) ffestb_decl_typeparams_2_);
-
-	case FFESTR_otherKIND:
-	  if (ffestb_local_.decl.kindt != NULL)
-	    break;
-	  ffelex_token_kill (ffesta_tokens[1]);
-	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					      FFEEXPR_contextKINDTYPE,
-			       (ffeexprCallback) ffestb_decl_typeparams_3_);
-
-	default:
-	  break;
-	}
-      break;
-
-    default:
-      nt = ffesta_tokens[1];
-      if (ffestb_local_.decl.lent == NULL)
-	next = (ffelexHandler) (*((ffelexHandler)
-				  ffeexpr_rhs (ffesta_output_pool,
-					       FFEEXPR_contextCHARACTERSIZE,
-			      (ffeexprCallback) ffestb_decl_typeparams_2_)))
-	  (nt);
-      else if (ffestb_local_.decl.kindt == NULL)
-	next = (ffelexHandler) (*((ffelexHandler)
-				  ffeexpr_rhs (ffesta_output_pool,
-					       FFEEXPR_contextKINDTYPE,
-			      (ffeexprCallback) ffestb_decl_typeparams_3_)))
-	  (nt);
-      else
-	{
-	  ffesta_tokens[1] = nt;
-	  break;
-	}
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-
-  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,
-		    ffestb_local_.decl.badname,
-		    ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_2_ -- "CHARACTER" OPEN_PAREN ["LEN="] expr
-
-   (ffestb_decl_typeparams_2_)	// to expression handler
-
-   Handle "[LEN=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_typeparams_2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_local_.decl.len = expr;
-      ffestb_local_.decl.lent = ffelex_token_use (ft);
-      ffelex_set_names (TRUE);
-      return (ffelexHandler) ffestb_local_.decl.handler;
-
-    case FFELEX_typeCOMMA:
-      ffestb_local_.decl.len = expr;
-      ffestb_local_.decl.lent = ffelex_token_use (ft);
-      return (ffelexHandler) ffestb_decl_typeparams_;
-
-    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,
-		    ffestb_local_.decl.badname,
-		    t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_typeparams_3_ -- "CHARACTER" OPEN_PAREN ["KIND="] expr
-
-   (ffestb_decl_typeparams_3_)	// to expression handler
-
-   Handle "[KIND=]expr)".  */
-
-static ffelexHandler
-ffestb_decl_typeparams_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_local_.decl.kind = expr;
-      ffestb_local_.decl.kindt = ffelex_token_use (ft);
-      ffelex_set_names (TRUE);
-      return (ffelexHandler) ffestb_local_.decl.handler;
-
-    case FFELEX_typeCOMMA:
-      ffestb_local_.decl.kind = expr;
-      ffestb_local_.decl.kindt = ffelex_token_use (ft);
-      return (ffelexHandler) ffestb_decl_typeparams_;
-
-    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,
-		    ffestb_local_.decl.badname,
-		    t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_subr_label_list_ -- Collect a tokenlist of labels and close-paren
-
-   return ffestb_subr_label_list_;  // to lexer after seeing OPEN_PAREN
-
-   First token must be a NUMBER.  Must be followed by zero or more COMMA
-   NUMBER pairs.  Must then be followed by a CLOSE_PAREN.  If all ok, put
-   the NUMBER tokens in a token list and return via the handler for the
-   token after CLOSE_PAREN.  Else return via
-   same handler, but with the ok return value set FALSE.  */
-
-static ffelexHandler
-ffestb_subr_label_list_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) == FFELEX_typeNUMBER)
-    {
-      ffestt_tokenlist_append (ffestb_subrargs_.label_list.labels,
-			       ffelex_token_use (t));
-      return (ffelexHandler) ffestb_subr_label_list_1_;
-    }
-
-  ffestb_subrargs_.label_list.ok = FALSE;
-  return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
-}
-
-/* ffestb_subr_label_list_1_ -- NUMBER
-
-   return ffestb_subr_label_list_1_;  // to lexer after seeing NUMBER
-
-   The next token must be COMMA, in which case go back to
-   ffestb_subr_label_list_, or CLOSE_PAREN, in which case set ok to TRUE
-   and go to the handler.  */
-
-static ffelexHandler
-ffestb_subr_label_list_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_subr_label_list_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_subrargs_.label_list.ok = TRUE;
-      return (ffelexHandler) ffestb_subrargs_.label_list.handler;
-
-    default:
-      ffestb_subrargs_.label_list.ok = FALSE;
-      return (ffelexHandler) (*ffestb_subrargs_.label_list.handler) (t);
-    }
-}
-
-/* ffestb_do -- Parse the DO statement
-
-   return ffestb_do;  // to lexer
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_do (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexHandler next;
-  ffelexToken nt;
-  ffestrSecond kw;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstDO)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeNUMBER:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_do1_;
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_do2_;
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  ffesta_tokens[2] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_do3_;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_do1_ (t);
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstDO)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDO);
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:	/* Must be "DO" label "WHILE". */
-	  if (! ISDIGIT (*p))
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
-							     i);
-	  p += ffelex_token_length (ffesta_tokens[1]);
-	  i += ffelex_token_length (ffesta_tokens[1]);
-	  if (((*p) != 'W') && ((*p) != 'w'))
-	    goto bad_i1;	/* :::::::::::::::::::: */
-	  nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-	  kw = ffestr_second (nt);
-	  ffelex_token_kill (nt);
-	  if (kw != FFESTR_secondWHILE)
-	    goto bad_i1;	/* :::::::::::::::::::: */
-	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		     FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (*p == '\0')
-	    {
-	      ffesta_tokens[1] = NULL;
-	      return (ffelexHandler) ffestb_do2_;
-	    }
-	  if (! ISDIGIT (*p))
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  ffesta_tokens[1] = ffelex_token_number_from_names (ffesta_tokens[0],
-							     i);
-	  p += ffelex_token_length (ffesta_tokens[1]);
-	  i += ffelex_token_length (ffesta_tokens[1]);
-	  if (*p != '\0')
-	    goto bad_i1;	/* :::::::::::::::::::: */
-	  return (ffelexHandler) ffestb_do2_;
-
-	case FFELEX_typeEQUALS:
-	  if (ISDIGIT (*p))
-	    {
-	      ffesta_tokens[1]
-		= ffelex_token_number_from_names (ffesta_tokens[0], i);
-	      p += ffelex_token_length (ffesta_tokens[1]);
-	      i += ffelex_token_length (ffesta_tokens[1]);
-	    }
-	  else
-	    ffesta_tokens[1] = NULL;
-	  if (!ffesrc_is_name_init (*p))
-	    goto bad_i1;	/* :::::::::::::::::::: */
-	  nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-	  next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
-				    (ffesta_output_pool, FFEEXPR_contextDO,
-				     (ffeexprCallback) ffestb_do6_)))
-	    (nt);
-	  ffelex_token_kill (nt);	/* Will get it back in _6_... */
-	  return (ffelexHandler) (*next) (t);
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  if (ISDIGIT (*p))
-	    {
-	      ffesta_tokens[1]
-		= ffelex_token_number_from_names (ffesta_tokens[0], i);
-	      p += ffelex_token_length (ffesta_tokens[1]);
-	      i += ffelex_token_length (ffesta_tokens[1]);
-	    }
-	  else
-	    ffesta_tokens[1] = NULL;
-	  if (*p != '\0')
-	    goto bad_i1;	/* :::::::::::::::::::: */
-	  return (ffelexHandler) ffestb_do1_ (t);
-	}
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i1:			/* :::::::::::::::::::: */
-  if (ffesta_tokens[1])
-    ffelex_token_kill (ffesta_tokens[1]);
-
-bad_i:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dowhile -- Parse the DOWHILE statement
-
-   return ffestb_dowhile;  // to lexer
-
-   Make sure the statement has a valid form for the DOWHILE statement.	If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_dowhile (ffelexToken t)
-{
-  ffeTokenLength i;
-  const char *p;
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstDOWHILE)
-	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:
-	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDOWHILE);
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		     FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
-
-	case FFELEX_typeEQUALS:/* Not really DOWHILE, but DOWHILExyz=.... */
-	  ffesta_tokens[1] = NULL;
-	  nt = ffelex_token_name_from_names (ffesta_tokens[0], FFESTR_firstlDO,
-					     0);
-	  next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs
-				    (ffesta_output_pool, FFEEXPR_contextDO,
-				     (ffeexprCallback) ffestb_do6_)))
-	    (nt);
-	  ffelex_token_kill (nt);	/* Will get it back in _6_... */
-	  return (ffelexHandler) (*next) (t);
-	}
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do1_ -- "DO" [label]
-
-   return ffestb_do1_;	// to lexer
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      return (ffelexHandler) ffestb_do2_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffesta_tokens[1] != NULL)
-	    ffestc_R819B (ffesta_construct_name, ffesta_tokens[1], NULL,
-			  NULL);
-	  else
-	    ffestc_R820B (ffesta_construct_name, NULL, NULL);
-	}
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      if (ffesta_construct_name != NULL)
-	{
-	  ffelex_token_kill (ffesta_construct_name);
-	  ffesta_construct_name = NULL;
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeNAME:
-      return (ffelexHandler) ffestb_do2_ (t);
-
-    default:
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do2_ -- "DO" [label] [,]
-
-   return ffestb_do2_;	// to lexer
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_do3_;
-
-    default:
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do3_ -- "DO" [label] [,] NAME
-
-   return ffestb_do3_;	// to lexer
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do3_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-			 FFEEXPR_contextDO, (ffeexprCallback) ffestb_do6_)))
-	(ffesta_tokens[2]);
-      ffelex_token_kill (ffesta_tokens[2]);	/* Will get it back in _6_... */
-      return (ffelexHandler) (*next) (t);
-
-    case FFELEX_typeOPEN_PAREN:
-      if (ffestr_second (ffesta_tokens[2]) != FFESTR_secondWHILE)
-	{
-	  if (ffesta_tokens[1] != NULL)
-	    ffelex_token_kill (ffesta_tokens[1]);
-	  if (ffesta_construct_name != NULL)
-	    {
-	      ffelex_token_kill (ffesta_construct_name);
-	      ffesta_construct_name = NULL;
-	    }
-	  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", ffesta_tokens[2]);
-	  ffelex_token_kill (ffesta_tokens[2]);
-	  return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);	/* Invalid token. */
-	}
-      ffelex_token_kill (ffesta_tokens[2]);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		     FFEEXPR_contextDOWHILE, (ffeexprCallback) ffestb_do4_);
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[2]);
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do4_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr
-
-   (ffestb_do4_)  // to expression handler
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffesta_tokens[2] = ffelex_token_use (ft);
-      ffestb_local_.dowhile.expr = expr;
-      return (ffelexHandler) ffestb_do5_;
-
-    default:
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do5_ -- "DO" [label] [,] "WHILE" OPEN_PAREN expr CLOSE_PAREN
-
-   return ffestb_do5_;	// to lexer
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do5_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffesta_tokens[1] != NULL)
-	    ffestc_R819B (ffesta_construct_name, ffesta_tokens[1],
-			  ffestb_local_.dowhile.expr, ffesta_tokens[2]);
-	  else
-	    ffestc_R820B (ffesta_construct_name, ffestb_local_.dowhile.expr,
-			  ffesta_tokens[2]);
-	}
-      ffelex_token_kill (ffesta_tokens[2]);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      if (ffesta_construct_name != NULL)
-	{
-	  ffelex_token_kill (ffesta_construct_name);
-	  ffesta_construct_name = NULL;
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[2]);
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do6_ -- "DO" [label] [,] var-expr
-
-   (ffestb_do6_)  // to expression handler
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do6_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  /* _3_ already ensured that this would be an EQUALS token.  If not, it is a
-     bug in the FFE. */
-
-  assert (ffelex_token_type (t) == FFELEX_typeEQUALS);
-
-  ffesta_tokens[2] = ffelex_token_use (ft);
-  ffestb_local_.do_stmt.var = expr;
-  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-			  FFEEXPR_contextDO, (ffeexprCallback) ffestb_do7_);
-}
-
-/* ffestb_do7_ -- "DO" [label] [,] var-expr EQUALS expr
-
-   (ffestb_do7_)  // to expression handler
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do7_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      ffesta_tokens[3] = ffelex_token_use (ft);
-      ffestb_local_.do_stmt.start = expr;
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-			  FFEEXPR_contextDO, (ffeexprCallback) ffestb_do8_);
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[2]);
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do8_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
-
-   (ffestb_do8_)  // to expression handler
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do8_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      ffesta_tokens[4] = ffelex_token_use (ft);
-      ffestb_local_.do_stmt.end = expr;
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-			  FFEEXPR_contextDO, (ffeexprCallback) ffestb_do9_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      ffesta_tokens[4] = ffelex_token_use (ft);
-      ffestb_local_.do_stmt.end = expr;
-      return (ffelexHandler) ffestb_do9_ (NULL, NULL, t);
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[3]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_do9_ -- "DO" [label] [,] var-expr EQUALS expr COMMA expr
-		  [COMMA expr]
-
-   (ffestb_do9_)  // to expression handler
-
-   Make sure the statement has a valid form for the DO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_do9_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if ((expr == NULL) && (ft != NULL))
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffesta_tokens[1] != NULL)
-	    ffestc_R819A (ffesta_construct_name, ffesta_tokens[1],
-			  ffestb_local_.do_stmt.var, ffesta_tokens[2],
-			  ffestb_local_.do_stmt.start, ffesta_tokens[3],
-		     ffestb_local_.do_stmt.end, ffesta_tokens[4], expr, ft);
-	  else
-	    ffestc_R820A (ffesta_construct_name, ffestb_local_.do_stmt.var,
-			  ffesta_tokens[2], ffestb_local_.do_stmt.start,
-			  ffesta_tokens[3], ffestb_local_.do_stmt.end,
-			  ffesta_tokens[4], expr, ft);
-	}
-      ffelex_token_kill (ffesta_tokens[4]);
-      ffelex_token_kill (ffesta_tokens[3]);
-      ffelex_token_kill (ffesta_tokens[2]);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      if (ffesta_construct_name != NULL)
-	{
-	  ffelex_token_kill (ffesta_construct_name);
-	  ffesta_construct_name = NULL;
-	}
-
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[4]);
-  ffelex_token_kill (ffesta_tokens[3]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else -- Parse the ELSE statement
-
-   return ffestb_else;	// to lexer
-
-   Make sure the statement has a valid form for the ELSE statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_else (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstELSE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  ffestb_args.elsexyz.second = FFESTR_secondNone;
-	  return (ffelexHandler) ffestb_else1_ (t);
-
-	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_args.elsexyz.second = ffesta_second_kw;
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_else1_;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstELSE)
-	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_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSE)
-	{
-	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
-	  if (!ffesrc_is_name_init (*p))
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  ffesta_tokens[1]
-	    = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-	}
-      else
-	ffesta_tokens[1] = NULL;
-      ffestb_args.elsexyz.second = FFESTR_secondNone;
-      return (ffelexHandler) ffestb_else1_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_elsexyz -- Parse an ELSEIF/ELSEWHERE statement
-
-   return ffestb_elsexyz;  // to lexer
-
-   Expects len and second to be set in ffestb_args.elsexyz to the length
-   of the ELSExyz keyword involved and the corresponding ffestrSecond value.  */
-
-ffelexHandler
-ffestb_elsexyz (ffelexToken t)
-{
-  ffeTokenLength i;
-  const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  if (ffesta_first_kw == FFESTR_firstELSEIF)
-	    goto bad_0;		/* :::::::::::::::::::: */
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_else1_ (t);
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (ffesta_first_kw != FFESTR_firstELSEIF)
-	    goto bad_0;		/* :::::::::::::::::::: */
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_else1_ (t);
-
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-    case FFELEX_typeNAMES:
-      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:
-	  if (ffesta_first_kw != FFESTR_firstELSEIF)
-	    goto bad_1;		/* :::::::::::::::::::: */
-	  if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlELSEIF)
-	    {
-	      i = FFESTR_firstlELSEIF;
-	      goto bad_i;	/* :::::::::::::::::::: */
-	    }
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_else1_ (t);
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlELSE);
-      ffesta_tokens[1]
-	= ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      return (ffelexHandler) ffestb_else1_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else1_ -- "ELSE" (NAME)
-
-   return ffestb_else1_;  // to lexer
-
-   If EOS/SEMICOLON, implement the appropriate statement (keep in mind that
-   "ELSE WHERE" is ambiguous at the syntactic level).  If OPEN_PAREN, start
-   expression analysis with callback at _2_.  */
-
-static ffelexHandler
-ffestb_else1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      if (ffestb_args.elsexyz.second == FFESTR_secondIF)
-	{
-	  if (ffesta_tokens[1] != NULL)
-	    ffelex_token_kill (ffesta_tokens[1]);
-	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-			FFEEXPR_contextIF, (ffeexprCallback) ffestb_else2_);
-	}
-      /* Fall through. */
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE", t);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      break;
-
-    }
-
-  switch (ffestb_args.elsexyz.second)
-    {
-
-    default:
-      if (!ffesta_is_inhibited ())
-	ffestc_R805 (ffesta_tokens[1]);
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffesta_zero (t);
-}
-
-/* ffestb_else2_ -- "ELSE" "IF" OPEN_PAREN expr
-
-   (ffestb_else2_)  // to expression handler
-
-   Make sure the next token is CLOSE_PAREN.  */
-
-static ffelexHandler
-ffestb_else2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffestb_local_.else_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_else3_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else3_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN
-
-   return ffestb_else3_;  // to lexer
-
-   Make sure the next token is "THEN".	*/
-
-static ffelexHandler
-ffestb_else3_ (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_confirmed ();
-      if (ffestr_first (t) == FFESTR_firstTHEN)
-	return (ffelexHandler) ffestb_else4_;
-      break;
-
-    case FFELEX_typeNAMES:
-      ffesta_confirmed ();
-      if (ffestr_first (t) != FFESTR_firstTHEN)
-	break;
-      if (ffelex_token_length (t) == FFESTR_firstlTHEN)
-	return (ffelexHandler) ffestb_else4_;
-      p = ffelex_token_text (t) + (i = FFESTR_firstlTHEN);
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffesta_tokens[2] = ffelex_token_name_from_names (t, i, 0);
-      return (ffelexHandler) ffestb_else5_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t, i, NULL);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else4_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
-
-   return ffestb_else4_;  // to lexer
-
-   Handle a NAME or EOS/SEMICOLON, then go to state _5_.  */
-
-static ffelexHandler
-ffestb_else4_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_tokens[2] = NULL;
-      return (ffelexHandler) ffestb_else5_ (t);
-
-    case FFELEX_typeNAME:
-      ffesta_tokens[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_else5_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_else5_ -- "ELSE" "IF" OPEN_PAREN expr CLOSE_PAREN "THEN"
-
-   return ffestb_else5_;  // to lexer
-
-   Make sure the next token is EOS or SEMICOLON; implement R804.  */
-
-static ffelexHandler
-ffestb_else5_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R804 (ffestb_local_.else_stmt.expr, ffesta_tokens[1],
-		     ffesta_tokens[2]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffesta_tokens[2] != NULL)
-	ffelex_token_kill (ffesta_tokens[2]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ELSE IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_tokens[2] != NULL)
-    ffelex_token_kill (ffesta_tokens[2]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_end -- Parse the END statement
-
-   return ffestb_end;  // to lexer
-
-   Make sure the statement has a valid form for the END statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_end (ffelexToken t)
-{
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstEND)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_tokens[1] = NULL;
-	  ffestb_args.endxyz.second = FFESTR_secondNone;
-	  return (ffelexHandler) ffestb_end3_ (t);
-
-	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_args.endxyz.second = ffesta_second_kw;
-      switch (ffesta_second_kw)
-	{
-	case FFESTR_secondFILE:
-	  ffestb_args.beru.badname = "ENDFILE";
-	  return (ffelexHandler) ffestb_beru;
-
-	case FFESTR_secondBLOCK:
-	  return (ffelexHandler) ffestb_end1_;
-
-	case FFESTR_secondNone:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  return (ffelexHandler) ffestb_end2_;
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstEND)
-	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_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEND)
-	{
-	  i = FFESTR_firstlEND;
-	  goto bad_i;		/* :::::::::::::::::::: */
-	}
-      ffesta_tokens[1] = NULL;
-      ffestb_args.endxyz.second = FFESTR_secondNone;
-      return (ffelexHandler) ffestb_end3_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_endxyz -- Parse an ENDxyz statement
-
-   return ffestb_endxyz;  // to lexer
-
-   Expects len and second to be set in ffestb_args.endxyz to the length
-   of the ENDxyz keyword involved and the corresponding ffestrSecond value.  */
-
-ffelexHandler
-ffestb_endxyz (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_end3_ (t);
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  switch (ffestb_args.endxyz.second)
-	    {
-	    case FFESTR_secondBLOCK:
-	      if (ffesta_second_kw != FFESTR_secondDATA)
-		goto bad_1;	/* :::::::::::::::::::: */
-	      return (ffelexHandler) ffestb_end2_;
-
-	    default:
-	      return (ffelexHandler) ffestb_end2_ (t);
-	    }
-
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-    case FFELEX_typeNAMES:
-      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_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      if (ffestb_args.endxyz.second == FFESTR_secondBLOCK)
-	{
-	  i = FFESTR_firstlEND;
-	  goto bad_i;		/* :::::::::::::::::::: */
-	}
-      if (ffelex_token_length (ffesta_tokens[0]) != ffestb_args.endxyz.len)
-	{
-	  p = ffelex_token_text (ffesta_tokens[0])
-	    + (i = ffestb_args.endxyz.len);
-	  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_end3_ (t);
-	}
-      ffesta_tokens[1] = NULL;
-      return (ffelexHandler) ffestb_end3_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_end1_ -- "END" "BLOCK"
-
-   return ffestb_end1_;	 // to lexer
-
-   Make sure the next token is "DATA".	*/
-
-static ffelexHandler
-ffestb_end1_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) == FFELEX_typeNAME)
-      && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "DATA",
-			    "data", "Data")
-	  == 0))
-    {
-      return (ffelexHandler) ffestb_end2_;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_end2_ -- "END" <unit-kind>
-
-   return ffestb_end2_;	 // to lexer
-
-   Make sure the next token is a NAME or EOS.  */
-
-static ffelexHandler
-ffestb_end2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_end3_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_tokens[1] = NULL;
-      return (ffelexHandler) ffestb_end3_ (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_end3_ -- "END" <unit-kind> (NAME)
-
-   return ffestb_end3_;	 // to lexer
-
-   Make sure the next token is an EOS, then implement the statement.  */
-
-static ffelexHandler
-ffestb_end3_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", t);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (ffestb_args.endxyz.second == FFESTR_secondNone)
-	{
-	  if (!ffesta_is_inhibited ())
-	    ffestc_end ();
-	  return (ffelexHandler) ffesta_zero (t);
-	}
-      break;
-    }
-
-  switch (ffestb_args.endxyz.second)
-    {
-    case FFESTR_secondIF:
-      if (!ffesta_is_inhibited ())
-	ffestc_R806 (ffesta_tokens[1]);
-      break;
-
-    case FFESTR_secondSELECT:
-      if (!ffesta_is_inhibited ())
-	ffestc_R811 (ffesta_tokens[1]);
-      break;
-
-    case FFESTR_secondDO:
-      if (!ffesta_is_inhibited ())
-	ffestc_R825 (ffesta_tokens[1]);
-      break;
-
-    case FFESTR_secondPROGRAM:
-      if (!ffesta_is_inhibited ())
-	ffestc_R1103 (ffesta_tokens[1]);
-      break;
-
-    case FFESTR_secondBLOCK:
-    case FFESTR_secondBLOCKDATA:
-      if (!ffesta_is_inhibited ())
-	ffestc_R1112 (ffesta_tokens[1]);
-      break;
-
-    case FFESTR_secondFUNCTION:
-      if (!ffesta_is_inhibited ())
-	ffestc_R1221 (ffesta_tokens[1]);
-      break;
-
-    case FFESTR_secondSUBROUTINE:
-      if (!ffesta_is_inhibited ())
-	ffestc_R1225 (ffesta_tokens[1]);
-      break;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "END", ffesta_tokens[0]);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffesta_zero (t);
-}
-
-/* ffestb_goto -- Parse the GOTO statement
-
-   return ffestb_goto;	// to lexer
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_goto (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstGO:
-	  if ((ffelex_token_type (t) != FFELEX_typeNAME)
-	      || (ffesta_second_kw != FFESTR_secondTO))
-	    goto bad_1;		/* :::::::::::::::::::: */
-	  ffesta_confirmed ();
-	  return (ffelexHandler) ffestb_goto1_;
-
-	case FFESTR_firstGOTO:
-	  return (ffelexHandler) ffestb_goto1_ (t);
-
-	default:
-	  goto bad_0;		/* :::::::::::::::::::: */
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstGOTO)
-	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_typeOPEN_PAREN:
-	case FFELEX_typePERCENT:	/* Since GOTO I%J is apparently valid
-					   in '90. */
-	case FFELEX_typeCOMMA:
-	  break;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-	}
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlGOTO)
-	{
-	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlGOTO);
-	  if (ISDIGIT (*p))
-	    {
-	      nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
-	      p += ffelex_token_length (nt);
-	      i += ffelex_token_length (nt);
-	      if (*p != '\0')
-		{
-		  ffelex_token_kill (nt);
-		  goto bad_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_goto1_ (nt);
-	  ffelex_token_kill (nt);
-	  return (ffelexHandler) (*next) (t);
-	}
-      return (ffelexHandler) ffestb_goto1_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "GO TO", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto1_ -- "GOTO" or "GO" "TO"
-
-   return ffestb_goto1_;  // to lexer
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
-	ffesta_confirmed ();
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_goto2_;
-
-    case FFELEX_typeOPEN_PAREN:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
-      ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto3_;
-      return (ffelexHandler) ffestb_subr_label_list_;
-
-    case FFELEX_typeNAME:
-      if (ffelex_token_type (ffesta_tokens[0]) == FFELEX_typeNAME)
-	ffesta_confirmed ();
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_lhs (ffesta_output_pool,
-					     FFEEXPR_contextAGOTO,
-					  (ffeexprCallback) ffestb_goto4_)))
-	(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, "GO TO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto2_ -- "GO/TO" NUMBER
-
-   return ffestb_goto2_;  // to lexer
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R836 (ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "GO TO", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto3_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN
-
-   return ffestb_goto3_;  // to lexer
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto3_ (ffelexToken t)
-{
-  if (!ffestb_subrargs_.label_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
-					  (ffeexprCallback) ffestb_goto5_);
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      break;
-
-    default:
-      ffesta_confirmed ();
-      /* Fall through. */
-    case FFELEX_typeOPEN_PAREN:	/* Could still be assignment!! */
-      return (ffelexHandler) (*((ffelexHandler)
-		      ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextCGOTO,
-				   (ffeexprCallback) ffestb_goto5_)))
-	(t);
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto4_ -- "GO/TO" expr
-
-   (ffestb_goto4_)  // to expression handler
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      ffesta_tokens[1] = ffelex_token_use (ft);
-      ffestb_local_.go_to.expr = expr;
-      return (ffelexHandler) ffestb_goto6_;
-
-    case FFELEX_typeOPEN_PAREN:
-      if (expr == NULL)
-	break;
-      ffesta_tokens[1] = ffelex_token_use (ft);
-      ffestb_local_.go_to.expr = expr;
-      return (ffelexHandler) ffestb_goto6_ (t);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R839 (expr, ft, NULL);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto5_ -- "GO/TO" OPEN_PAREN label-list CLOSE_PAREN (COMMA) expr
-
-   (ffestb_goto5_)  // to expression handler
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto5_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R837 (ffestb_subrargs_.label_list.labels, expr, ft);
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "computed-GOTO", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto6_ -- "GO/TO" expr (COMMA)
-
-   return ffestb_goto6_;  // to lexer
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto6_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      ffesta_tokens[2] = ffelex_token_use (t);
-      ffestb_subrargs_.label_list.labels = ffestt_tokenlist_create ();
-      ffestb_subrargs_.label_list.handler = (ffelexHandler) ffestb_goto7_;
-      return (ffelexHandler) ffestb_subr_label_list_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_goto7_ -- "GO/TO" expr (COMMA) OPEN_PAREN label-list CLOSE_PAREN
-
-   return ffestb_goto7_;  // to lexer
-
-   Make sure the statement has a valid form for the GOTO statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_goto7_ (ffelexToken t)
-{
-  if (!ffestb_subrargs_.label_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R839 (ffestb_local_.go_to.expr, ffesta_tokens[1],
-		     ffestb_subrargs_.label_list.labels);
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[2]);
-      ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assigned-GOTO", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffestt_tokenlist_kill (ffestb_subrargs_.label_list.labels);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_halt -- Parse the STOP/PAUSE statement
-
-   return ffestb_halt;	// to lexer
-
-   Make sure the statement has a valid form for the STOP/PAUSE statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_halt (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      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_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeNAME:
-	case FFELEX_typeNUMBER:
-	case FFELEX_typeAPOSTROPHE:
-	case FFELEX_typeQUOTE:
-	  ffesta_confirmed ();
-	  break;
-	}
-
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-					     FFEEXPR_contextSTOP,
-					  (ffeexprCallback) ffestb_halt1_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeNAME:
-	case FFELEX_typeNUMBER:
-	case FFELEX_typeAPOSTROPHE:
-	case FFELEX_typeQUOTE:
-	  ffesta_confirmed ();
-	  break;
-	}
-      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  FFEEXPR_contextSTOP,
-					  (ffeexprCallback) ffestb_halt1_);
-      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
-						   ffestb_args.halt.len);
-      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,
-		     (ffesta_first_kw == FFESTR_firstSTOP)
-		     ? "STOP" : "PAUSE",
-		     ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-		     (ffesta_first_kw == FFESTR_firstSTOP)
-		     ? "STOP" : "PAUSE",
-		     t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_halt1_ -- "STOP/PAUSE" expr
-
-   (ffestb_halt1_)  // to expression handler
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_halt1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffesta_first_kw == FFESTR_firstSTOP)
-	    ffestc_R842 (expr, ft);
-	  else
-	    ffestc_R843 (expr, ft);
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-			 (ffesta_first_kw == FFESTR_firstSTOP)
-			 ? "STOP" : "PAUSE",
-			 t);
-      break;
-    }
-
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_if -- Parse an IF statement
-
-   return ffestb_if;  // to lexer
-
-   Make sure the statement has a valid form for an IF statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_if (ffelexToken t)
-{
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstIF)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstIF)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
-	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_contextIF,
-				      (ffeexprCallback) ffestb_if1_);
-
-bad_0:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_if1_ -- "IF" OPEN_PAREN expr
-
-   (ffestb_if1_)  // to expression handler
-
-   Make sure the next token is CLOSE_PAREN.  */
-
-static ffelexHandler
-ffestb_if1_ (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_if2_;
-
-    default:
-      break;
-    }
-
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_if2_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
-
-   return ffestb_if2_;	// to lexer
-
-   Make sure the next token is NAME.  */
-
-static ffelexHandler
-ffestb_if2_ (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_if3_;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  if ((ffesta_construct_name == NULL)
-      || (ffelex_token_type (t) != FFELEX_typeNUMBER))
-    ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IF", t);
-  else
-    ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
-		       ffesta_construct_name, t);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_if3_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NAME
-
-   return ffestb_if3_;	// to lexer
-
-   If the next token is EOS or SEMICOLON and the preceding NAME was "THEN",
-   implement R803.  Else, implement R807 and send the preceding NAME followed
-   by the current token.  */
-
-static ffelexHandler
-ffestb_if3_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (ffestr_first (ffesta_tokens[2]) == FFESTR_firstTHEN)
-	{
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R803 (ffesta_construct_name, ffestb_local_.if_stmt.expr,
-			 ffesta_tokens[1]);
-	  ffelex_token_kill (ffesta_tokens[1]);
-	  ffelex_token_kill (ffesta_tokens[2]);
-	  if (ffesta_construct_name != NULL)
-	    {
-	      ffelex_token_kill (ffesta_construct_name);
-	      ffesta_construct_name = NULL;
-	    }
-	  return (ffelexHandler) ffesta_zero (t);
-	}
-      break;
-
-    default:
-      break;
-    }
-
-  if (ffesta_construct_name != NULL)
-    {
-      if (!ffesta_is_inhibited ())
-	ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
-			   ffesta_construct_name, ffesta_tokens[2]);
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[2]);
-      return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R807 (ffestb_local_.if_stmt.expr, ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[1]);
-  {
-    ffelexToken my_2 = ffesta_tokens[2];
-
-    next = (ffelexHandler) ffesta_two (my_2, t);
-    ffelex_token_kill (my_2);
-  }
-  return (ffelexHandler) next;
-}
-
-/* ffestb_let -- Parse an assignment statement
-
-   return ffestb_let;  // to lexer
-
-   Make sure the statement has a valid form for an assignment statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_let (ffelexToken t)
-{
-  ffelexHandler next;
-  bool vxtparam;		/* TRUE if it might really be a VXT PARAMETER
-				   stmt. */
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      vxtparam = FALSE;
-      break;
-
-    case FFELEX_typeNAMES:
-      vxtparam = TRUE;
-      break;
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-    case FFELEX_typePERCENT:
-    case FFELEX_typePOINTS:
-      ffestb_local_.let.vxtparam = FALSE;
-      break;
-
-    case FFELEX_typeEQUALS:
-      if (!vxtparam || (ffesta_first_kw != FFESTR_firstPARAMETER))
-	{
-	  ffestb_local_.let.vxtparam = FALSE;
-	  break;
-	}
-      p = ffelex_token_text (ffesta_tokens[0]) + FFESTR_firstlPARAMETER;
-      ffestb_local_.let.vxtparam = ffesrc_is_name_init (*p);
-      break;
-
-    default:
-      goto bad_1;		/* :::::::::::::::::::: */
-    }
-
-  next = (ffelexHandler) (*((ffelexHandler)
-			    ffeexpr_lhs (ffesta_output_pool,
-					 FFEEXPR_contextLET,
-					 (ffeexprCallback) ffestb_let1_)))
-    (ffesta_tokens[0]);
-  return (ffelexHandler) (*next) (t);
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_let1_ -- expr
-
-   (ffestb_let1_)  // to expression handler
-
-   Make sure the next token is EQUALS or POINTS.  */
-
-static ffelexHandler
-ffestb_let1_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  ffestb_local_.let.dest = expr;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      if (expr == NULL)
-	break;
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-			FFEEXPR_contextLET, (ffeexprCallback) ffestb_let2_);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "assignment", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_let2_ -- expr EQUALS/POINTS expr
-
-   (ffestb_end2_)  // to expression handler
-
-   Make sure the next token is EOS or SEMICOLON; implement the statement.  */
-
-static ffelexHandler
-ffestb_let2_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (ffestb_local_.let.vxtparam && !ffestc_is_let_not_V027 ())
-	break;
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_let (ffestb_local_.let.dest, expr, ft);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM,
-		     (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeEQUALS)
-		     ? "assignment" : "pointer-assignment",
-		     t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist -- Parse EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/PRIVATE
-		     statement
-
-   return ffestb_varlist;  // to lexer
-
-   Make sure the statement has a valid form.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_varlist (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  goto bad_1;	/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;	/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  goto bad_1;	/* :::::::::::::::::::: */
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  switch (ffesta_first_kw)
-	    {
-	    case FFESTR_firstEXTERNAL:
-	      if (!ffesta_is_inhibited ())
-		ffestc_R1207_start ();
-	      break;
-
-	    case FFESTR_firstINTRINSIC:
-	      if (!ffesta_is_inhibited ())
-		ffestc_R1208_start ();
-	      break;
-
-	    default:
-	      break;
-	    }
-	  return (ffelexHandler) ffestb_varlist5_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.varlist.len);
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  goto bad_1;	/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-
-	  if (*p != '\0')
-	    break;
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  goto bad_1;	/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  goto bad_1;	/* :::::::::::::::::::: */
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  switch (ffesta_first_kw)
-	    {
-	    case FFESTR_firstEXTERNAL:
-	      if (!ffesta_is_inhibited ())
-		ffestc_R1207_start ();
-	      break;
-
-	    case FFESTR_firstINTRINSIC:
-	      if (!ffesta_is_inhibited ())
-		ffestc_R1208_start ();
-	      break;
-
-	    default:
-	      break;
-	    }
-	  return (ffelexHandler) ffestb_varlist5_ (t);
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-      /* Here, we have at least one char after the first keyword and t is
-	 COMMA or EOS/SEMICOLON.  Also we know that this form is valid for
-	 only the statements reaching here (specifically, INTENT won't reach
-	 here). */
-
-      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_firstEXTERNAL:
-	      ffestc_R1207_start ();
-	      break;
-
-	    case FFESTR_firstINTRINSIC:
-	      ffestc_R1208_start ();
-	      break;
-
-	    default:
-	      assert (FALSE);
-	    }
-	}
-      next = (ffelexHandler) ffestb_varlist5_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.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.varlist.badname, ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist5_ -- Handles the list of variable names
-
-   return ffestb_varlist5_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_varlist5_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_varlist6_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.varlist.badname, t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    {
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstEXTERNAL:
-	  ffestc_R1207_finish ();
-	  break;
-
-	case FFESTR_firstINTRINSIC:
-	  ffestc_R1208_finish ();
-	  break;
-
-	default:
-	  assert (FALSE);
-	}
-    }
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_varlist6_ -- (whatever) NAME
-
-   return ffestb_varlist6_;  // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_varlist6_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	{
-	  switch (ffesta_first_kw)
-	    {
-	    case FFESTR_firstEXTERNAL:
-	      ffestc_R1207_item (ffesta_tokens[1]);
-	      break;
-
-	    case FFESTR_firstINTRINSIC:
-	      ffestc_R1208_item (ffesta_tokens[1]);
-	      break;
-
-	    default:
-	      assert (FALSE);
-	    }
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_varlist5_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  switch (ffesta_first_kw)
-	    {
-	    case FFESTR_firstEXTERNAL:
-	      ffestc_R1207_item (ffesta_tokens[1]);
-	      ffestc_R1207_finish ();
-	      break;
-
-	    case FFESTR_firstINTRINSIC:
-	      ffestc_R1208_item (ffesta_tokens[1]);
-	      ffestc_R1208_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.varlist.badname, t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    {
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstEXTERNAL:
-	  ffestc_R1207_finish ();
-	  break;
-
-	case FFESTR_firstINTRINSIC:
-	  ffestc_R1208_finish ();
-	  break;
-
-	default:
-	  assert (FALSE);
-	}
-    }
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R522 -- Parse the SAVE statement
-
-   return ffestb_R522;	// to lexer
-
-   Make sure the statement has a valid form for the SAVE statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R522 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstSAVE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R522 ();
-	  return (ffelexHandler) ffesta_zero (t);
-
-	case FFELEX_typeNAME:
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R522start ();
-	  return (ffelexHandler) ffestb_R5221_ (t);
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R522start ();
-	  return (ffelexHandler) ffestb_R5221_;
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstSAVE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlSAVE);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R522 ();
-	  return (ffelexHandler) ffesta_zero (t);
-
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R522start ();
-	  return (ffelexHandler) ffestb_R5221_ (t);
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R522start ();
-	  return (ffelexHandler) ffestb_R5221_;
-	}
-
-      /* Here, we have at least one char after "SAVE" and t is COMMA or
-	 EOS/SEMICOLON. */
-
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      if (!ffesta_is_inhibited ())
-	ffestc_R522start ();
-      next = (ffelexHandler) ffestb_R5221_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SAVE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5221_ -- "SAVE" [COLONCOLON]
-
-   return ffestb_R5221_;  // to lexer
-
-   Handle NAME or SLASH.  */
-
-static ffelexHandler
-ffestb_R5221_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffestb_local_.R522.is_cblock = FALSE;
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R5224_;
-
-    case FFELEX_typeSLASH:
-      ffestb_local_.R522.is_cblock = TRUE;
-      return (ffelexHandler) ffestb_R5222_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R522finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5222_ -- "SAVE" [COLONCOLON] SLASH
-
-   return ffestb_R5222_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_R5222_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R5223_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R522finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5223_ -- "SAVE" [COLONCOLON] SLASH NAME
-
-   return ffestb_R5223_;  // to lexer
-
-   Handle SLASH.  */
-
-static ffelexHandler
-ffestb_R5223_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_R5224_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R522finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5224_ -- "SAVE" [COLONCOLON] R523
-
-   return ffestb_R5224_;  // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R5224_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffestb_local_.R522.is_cblock)
-	    ffestc_R522item_cblock (ffesta_tokens[1]);
-	  else
-	    ffestc_R522item_object (ffesta_tokens[1]);
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_R5221_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffestb_local_.R522.is_cblock)
-	    ffestc_R522item_cblock (ffesta_tokens[1]);
-	  else
-	    ffestc_R522item_object (ffesta_tokens[1]);
-	  ffestc_R522finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SAVE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R522finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R528 -- Parse the DATA statement
-
-   return ffestb_R528;	// to lexer
-
-   Make sure the statement has a valid form for the DATA statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R528 (ffelexToken t)
-{
-  unsigned const char *p;
-  ffeTokenLength i;
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstDATA)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeSLASH:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeOPEN_PAREN:
-	  break;
-	}
-      ffestb_local_.data.started = FALSE;
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_lhs (ffesta_output_pool,
-					     FFEEXPR_contextDATA,
-					  (ffeexprCallback) ffestb_R5281_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstDATA)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlDATA);
-      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_typeOPEN_PAREN:
-	  if (*p == '\0')
-	    {
-	      ffestb_local_.data.started = FALSE;
-	      return (ffelexHandler) (*((ffelexHandler)
-					ffeexpr_lhs (ffesta_output_pool,
-						     FFEEXPR_contextDATA,
-						     (ffeexprCallback)
-						     ffestb_R5281_)))
-		(t);
-	    }
-	  break;
-
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  break;
-	}
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffestb_local_.data.started = FALSE;
-      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      next = (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_lhs (ffesta_output_pool,
-					     FFEEXPR_contextDATA,
-					  (ffeexprCallback) ffestb_R5281_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "DATA", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5281_ -- "DATA" expr-list
-
-   (ffestb_R5281_)  // to expression handler
-
-   Handle COMMA or SLASH.  */
-
-static ffelexHandler
-ffestb_R5281_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.data.started)
-	    {
-	      ffestc_R528_start ();
-	      ffestb_local_.data.started = TRUE;
-	    }
-	  ffestc_R528_item_object (expr, ft);
-	}
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  FFEEXPR_contextDATA,
-					  (ffeexprCallback) ffestb_R5281_);
-
-    case FFELEX_typeSLASH:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.data.started)
-	    {
-	      ffestc_R528_start ();
-	      ffestb_local_.data.started = TRUE;
-	    }
-	  ffestc_R528_item_object (expr, ft);
-	  ffestc_R528_item_startvals ();
-	}
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_R5282_);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
-      break;
-    }
-
-  if (ffestb_local_.data.started && !ffesta_is_inhibited ())
-    ffestc_R528_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5282_ -- "DATA" expr-list SLASH expr-list
-
-   (ffestb_R5282_)  // to expression handler
-
-   Handle ASTERISK, COMMA, or SLASH.  */
-
-static ffelexHandler
-ffestb_R5282_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R528_item_value (NULL, NULL, expr, ft);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_R5282_);
-
-    case FFELEX_typeASTERISK:
-      if (expr == NULL)
-	break;
-      ffestb_local_.data.expr = ffeexpr_convert (expr, ft, t,
-						 FFEINFO_basictypeINTEGER,
-						 FFEINFO_kindtypeINTEGER1,
-						 0,
-						 FFETARGET_charactersizeNONE,
-						 FFEEXPR_contextLET);
-      ffesta_tokens[1] = ffelex_token_use (ft);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_R5283_);
-
-    case FFELEX_typeSLASH:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R528_item_value (NULL, NULL, expr, ft);
-	  ffestc_R528_item_endvals (t);
-	}
-      return (ffelexHandler) ffestb_R5284_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    {
-      ffestc_R528_item_endvals (t);
-      ffestc_R528_finish ();
-    }
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5283_ -- "DATA" expr-list SLASH expr ASTERISK expr
-
-   (ffestb_R5283_)  // to expression handler
-
-   Handle COMMA or SLASH.  */
-
-static ffelexHandler
-ffestb_R5283_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
-				expr, ft);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_R5282_);
-
-    case FFELEX_typeSLASH:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R528_item_value (ffestb_local_.data.expr, ffesta_tokens[1],
-				  expr, ft);
-	  ffestc_R528_item_endvals (t);
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_R5284_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    {
-      ffestc_R528_item_endvals (t);
-      ffestc_R528_finish ();
-    }
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5284_ -- "DATA" expr-list SLASH expr-list SLASH
-
-   return ffestb_R5284_;  // to lexer
-
-   Handle [COMMA] NAME or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R5284_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  FFEEXPR_contextDATA,
-					  (ffeexprCallback) ffestb_R5281_);
-
-    case FFELEX_typeNAME:
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_lhs (ffesta_output_pool,
-					     FFEEXPR_contextDATA,
-					  (ffeexprCallback) ffestb_R5281_)))
-	(t);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R528_finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "DATA", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R528_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R537 -- Parse a PARAMETER statement
-
-   return ffestb_R537;	// to lexer
-
-   Make sure the statement has a valid form for an PARAMETER statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R537 (ffelexToken t)
-{
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstPARAMETER)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstPARAMETER)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlPARAMETER)
-	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_.parameter.started = FALSE;
-  return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-				      FFEEXPR_contextPARAMETER,
-				      (ffeexprCallback) ffestb_R5371_);
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R5371_ -- "PARAMETER" OPEN_PAREN expr
-
-   (ffestb_R5371_)  // to expression handler
-
-   Make sure the next token is EQUALS.	*/
-
-static ffelexHandler
-ffestb_R5371_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  ffestb_local_.parameter.expr = expr;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      ffesta_tokens[1] = ffelex_token_use (ft);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_R5372_);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-  if (ffestb_local_.parameter.started)
-    ffestc_R537_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5372_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr
-
-   (ffestb_R5372_)  // to expression handler
-
-   Make sure the next token is COMMA or CLOSE_PAREN.  */
-
-static ffelexHandler
-ffestb_R5372_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.parameter.started)
-	    {
-	      ffestc_R537_start ();
-	      ffestb_local_.parameter.started = TRUE;
-	    }
-	  ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
-			    expr, ft);
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  FFEEXPR_contextPARAMETER,
-					  (ffeexprCallback) ffestb_R5371_);
-
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.parameter.started)
-	    {
-	      ffestc_R537_start ();
-	      ffestb_local_.parameter.started = TRUE;
-	    }
-	  ffestc_R537_item (ffestb_local_.parameter.expr, ffesta_tokens[1],
-			    expr, ft);
-	  ffestc_R537_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_R5373_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-  if (ffestb_local_.parameter.started)
-    ffestc_R537_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5373_ -- "PARAMETER" OPEN_PAREN expr EQUALS expr CLOSE_PAREN
-
-   return ffestb_R5373_;  // to lexer
-
-   Make sure the next token is EOS or SEMICOLON, or generate an error.	All
-   cleanup has already been done, by the way.  */
-
-static ffelexHandler
-ffestb_R5373_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R542 -- Parse the NAMELIST statement
-
-   return ffestb_R542;	// to lexer
-
-   Make sure the statement has a valid form for the NAMELIST statement.	 If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R542 (ffelexToken t)
-{
-  const char *p;
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstNAMELIST)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstNAMELIST)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlNAMELIST);
-      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_R542_start ();
-  return (ffelexHandler) ffestb_R5421_;
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "NAMELIST", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5421_ -- "NAMELIST" SLASH
-
-   return ffestb_R5421_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_R5421_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (!ffesta_is_inhibited ())
-	ffestc_R542_item_nlist (t);
-      return (ffelexHandler) ffestb_R5422_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R542_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5422_ -- "NAMELIST" SLASH NAME
-
-   return ffestb_R5422_;  // to lexer
-
-   Handle SLASH.  */
-
-static ffelexHandler
-ffestb_R5422_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_R5423_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R542_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5423_ -- "NAMELIST" SLASH NAME SLASH
-
-   return ffestb_R5423_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_R5423_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (!ffesta_is_inhibited ())
-	ffestc_R542_item_nitem (t);
-      return (ffelexHandler) ffestb_R5424_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R542_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5424_ -- "NAMELIST" SLASH NAME SLASH NAME
-
-   return ffestb_R5424_;  // to lexer
-
-   Handle COMMA, EOS/SEMICOLON, or SLASH.  */
-
-static ffelexHandler
-ffestb_R5424_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R5425_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R542_finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_R5421_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R542_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5425_ -- "NAMELIST" SLASH NAME SLASH NAME COMMA
-
-   return ffestb_R5425_;  // to lexer
-
-   Handle NAME or SLASH.  */
-
-static ffelexHandler
-ffestb_R5425_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (!ffesta_is_inhibited ())
-	ffestc_R542_item_nitem (t);
-      return (ffelexHandler) ffestb_R5424_;
-
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_R5421_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "NAMELIST", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R542_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R544 -- Parse an EQUIVALENCE statement
-
-   return ffestb_R544;	// to lexer
-
-   Make sure the statement has a valid form for an EQUIVALENCE statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R544 (ffelexToken t)
-{
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstEQUIVALENCE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlEQUIVALENCE)
-	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_.equivalence.started = FALSE;
-  return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-				      FFEEXPR_contextEQUIVALENCE,
-				      (ffeexprCallback) ffestb_R5441_);
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R5441_ -- "EQUIVALENCE" OPEN_PAREN expr
-
-   (ffestb_R5441_)  // to expression handler
-
-   Make sure the next token is COMMA.  */
-
-static ffelexHandler
-ffestb_R5441_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      ffestb_local_.equivalence.exprs = ffestt_exprlist_create ();
-      ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
-			      ffelex_token_use (ft));
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  FFEEXPR_contextEQUIVALENCE,
-					  (ffeexprCallback) ffestb_R5442_);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
-  if (ffestb_local_.equivalence.started)
-    ffestc_R544_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5442_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr
-
-   (ffestb_R5442_)  // to expression handler
-
-   Make sure the next token is COMMA or CLOSE_PAREN.  For COMMA, we just
-   append the expression to our list and continue; for CLOSE_PAREN, we
-   append the expression and move to _3_.  */
-
-static ffelexHandler
-ffestb_R5442_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
-			      ffelex_token_use (ft));
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  FFEEXPR_contextEQUIVALENCE,
-					  (ffeexprCallback) ffestb_R5442_);
-
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestt_exprlist_append (ffestb_local_.equivalence.exprs, expr,
-			      ffelex_token_use (ft));
-      return (ffelexHandler) ffestb_R5443_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
-  if (ffestb_local_.equivalence.started)
-    ffestc_R544_finish ();
-  ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5443_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN
-
-   return ffestb_R5443_;  // to lexer
-
-   Make sure the next token is COMMA or EOS/SEMICOLON.	*/
-
-static ffelexHandler
-ffestb_R5443_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.equivalence.started)
-	    {
-	      ffestc_R544_start ();
-	      ffestb_local_.equivalence.started = TRUE;
-	    }
-	  ffestc_R544_item (ffestb_local_.equivalence.exprs);
-	}
-      ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
-      return (ffelexHandler) ffestb_R5444_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.equivalence.started)
-	    {
-	      ffestc_R544_start ();
-	      ffestb_local_.equivalence.started = TRUE;
-	    }
-	  ffestc_R544_item (ffestb_local_.equivalence.exprs);
-	  ffestc_R544_finish ();
-	}
-      ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
-  if (ffestb_local_.equivalence.started)
-    ffestc_R544_finish ();
-  ffestt_exprlist_kill (ffestb_local_.equivalence.exprs);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5444_ -- "EQUIVALENCE" OPEN_PAREN expr COMMA expr CLOSE_PAREN COMMA
-
-   return ffestb_R5444_;  // to lexer
-
-   Make sure the next token is OPEN_PAREN, or generate an error.  */
-
-static ffelexHandler
-ffestb_R5444_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  FFEEXPR_contextEQUIVALENCE,
-					  (ffeexprCallback) ffestb_R5441_);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EQUIVALENCE", t);
-  if (ffestb_local_.equivalence.started)
-    ffestc_R544_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R834 -- Parse the CYCLE statement
-
-   return ffestb_R834;	// to lexer
-
-   Make sure the statement has a valid form for the CYCLE statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R834 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCYCLE)
-	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_typeNAME:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R8341_;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_R8341_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstCYCLE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCYCLE);
-      if (*p == '\0')
-	{
-	  ffesta_tokens[1] = NULL;
-	}
-      else
-	{
-	  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_R8341_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CYCLE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8341_ -- "CYCLE" [NAME]
-
-   return ffestb_R8341_;  // to lexer
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R8341_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R834 (ffesta_tokens[1]);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CYCLE", t);
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R835 -- Parse the EXIT statement
-
-   return ffestb_R835;	// to lexer
-
-   Make sure the statement has a valid form for the EXIT statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R835 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstEXIT)
-	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_typeNAME:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R8351_;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_R8351_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstEXIT)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlEXIT);
-      if (*p == '\0')
-	{
-	  ffesta_tokens[1] = NULL;
-	}
-      else
-	{
-	  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_R8351_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "EXIT", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8351_ -- "EXIT" [NAME]
-
-   return ffestb_R8351_;  // to lexer
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R8351_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R835 (ffesta_tokens[1]);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "EXIT", t);
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R838 -- Parse the ASSIGN statement
-
-   return ffestb_R838;	// to lexer
-
-   Make sure the statement has a valid form for the ASSIGN statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R838 (ffelexToken t)
-{
-  unsigned const char *p;
-  ffeTokenLength i;
-  ffelexHandler next;
-  ffelexToken et;		/* First token in target. */
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstASSIGN)
-	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_typeNUMBER:
-	  break;
-	}
-      ffesta_tokens[1] = ffelex_token_use (t);
-      ffesta_confirmed ();
-      return (ffelexHandler) ffestb_R8381_;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstASSIGN)
-	goto bad_0;		/* :::::::::::::::::::: */
-
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  /* Fall through. */
-	case FFELEX_typePERCENT:
-	case FFELEX_typeOPEN_PAREN:
-	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlASSIGN);
-	  if (! ISDIGIT (*p))
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  ffesta_tokens[1]
-	    = ffelex_token_number_from_names (ffesta_tokens[0], i);
-	  p += ffelex_token_length (ffesta_tokens[1]);	/* Skip to "TO". */
-	  i += ffelex_token_length (ffesta_tokens[1]);
-	  if (!ffesrc_char_match_init (*p, 'T', 't')	/* "TO". */
-	      || (++i, !ffesrc_char_match_noninit (*++p, 'O', 'o')))
-	    {
-	    bad_i_1:		/* :::::::::::::::::::: */
-	      ffelex_token_kill (ffesta_tokens[1]);
-	      goto bad_i;	/* :::::::::::::::::::: */
-	    }
-	  ++p, ++i;
-	  if (!ffesrc_is_name_init (*p))
-	    goto bad_i_1;	/* :::::::::::::::::::: */
-	  et = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-	  next = (ffelexHandler)
-	    (*((ffelexHandler)
-	       ffeexpr_lhs (ffesta_output_pool,
-			    FFEEXPR_contextASSIGN,
-			    (ffeexprCallback)
-			    ffestb_R8383_)))
-	    (et);
-	  ffelex_token_kill (et);
-	  return (ffelexHandler) (*next) (t);
-
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid first token. */
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "ASSIGN", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8381_ -- "ASSIGN" NUMBER
-
-   return ffestb_R8381_;  // to lexer
-
-   Make sure the next token is "TO".  */
-
-static ffelexHandler
-ffestb_R8381_ (ffelexToken t)
-{
-  if ((ffelex_token_type (t) == FFELEX_typeNAME)
-  && (ffesrc_strcmp_2c (ffe_case_match (), ffelex_token_text (t), "TO", "to",
-			"To") == 0))
-    {
-      return (ffelexHandler) ffestb_R8382_;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
-  if (ffelex_token_type (t) == FFELEX_typeNAME)
-    return (ffelexHandler) ffestb_R8382_ (t);	/* Maybe user forgot "TO". */
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8382_ -- "ASSIGN" NUMBER ("TO")
-
-   return ffestb_R8382_;  // to lexer
-
-   Make sure the next token is a name, then pass it along to the expression
-   evaluator as an LHS expression.  The callback function is _3_.  */
-
-static ffelexHandler
-ffestb_R8382_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) == FFELEX_typeNAME)
-    {
-      return (ffelexHandler)
-      (*((ffelexHandler)
-	 ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextASSIGN,
-		      (ffeexprCallback) ffestb_R8383_)))
-      (t);
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8383_ -- "ASSIGN" NUMBER ("TO") expression
-
-   (ffestb_R8383_)  // to expression handler
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R8383_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R838 (ffesta_tokens[1], expr, ft);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "ASSIGN", t);
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R840 -- Parse an arithmetic-IF statement
-
-   return ffestb_R840;	// to lexer
-
-   Make sure the statement has a valid form for an arithmetic-IF statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R840 (ffelexToken t)
-{
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlIF)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffesta_first_kw != FFESTR_firstIF)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstIF)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      break;
-
-    default:
-      goto bad_1;		/* :::::::::::::::::::: */
-    }
-
-  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextARITHIF,
-				      (ffeexprCallback) ffestb_R8401_);
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R8401_ -- "IF" OPEN_PAREN expr
-
-   (ffestb_R8401_)  // to expression handler
-
-   Make sure the next token is CLOSE_PAREN.  */
-
-static ffelexHandler
-ffestb_R8401_ (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);	/* In case it's a logical IF instead. */
-      return (ffelexHandler) ffestb_R8402_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8402_ -- "IF" OPEN_PAREN expr CLOSE_PAREN
-
-   return ffestb_R8402_;  // to lexer
-
-   Make sure the next token is NUMBER.	*/
-
-static ffelexHandler
-ffestb_R8402_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffesta_confirmed ();
-      ffesta_tokens[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R8403_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8403_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER
-
-   return ffestb_R8403_;  // to lexer
-
-   Make sure the next token is COMMA.  */
-
-static ffelexHandler
-ffestb_R8403_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R8404_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8404_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA
-
-   return ffestb_R8404_;  // to lexer
-
-   Make sure the next token is NUMBER.	*/
-
-static ffelexHandler
-ffestb_R8404_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffesta_tokens[3] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R8405_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8405_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER
-
-   return ffestb_R8405_;  // to lexer
-
-   Make sure the next token is COMMA.  */
-
-static ffelexHandler
-ffestb_R8405_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R8406_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffelex_token_kill (ffesta_tokens[3]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8406_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
-
-   return ffestb_R8406_;  // to lexer
-
-   Make sure the next token is NUMBER.	*/
-
-static ffelexHandler
-ffestb_R8406_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffesta_tokens[4] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R8407_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffelex_token_kill (ffesta_tokens[3]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8407_ -- "IF" OPEN_PAREN expr CLOSE_PAREN NUMBER COMMA NUMBER COMMA
-		    NUMBER
-
-   return ffestb_R8407_;  // to lexer
-
-   Make sure the next token is EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R8407_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R840 (ffestb_local_.if_stmt.expr, ffesta_tokens[1],
-		     ffesta_tokens[2], ffesta_tokens[3], 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]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "arithmetic-IF", t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffelex_token_kill (ffesta_tokens[3]);
-  ffelex_token_kill (ffesta_tokens[4]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R841 -- Parse the CONTINUE statement
-
-   return ffestb_R841;	// to lexer
-
-   Make sure the statement has a valid form for the CONTINUE statement.	 If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R841 (ffelexToken t)
-{
-  const char *p;
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCONTINUE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstCONTINUE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCONTINUE)
-	{
-	  p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCONTINUE);
-	  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_R841 ();
-      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, "CONTINUE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid first token. */
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CONTINUE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CONTINUE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R1102 -- Parse the PROGRAM statement
-
-   return ffestb_R1102;	 // to lexer
-
-   Make sure the statement has a valid form for the PROGRAM statement.	If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R1102 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstPROGRAM)
-	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 ();
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R11021_;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstPROGRAM)
-	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_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPROGRAM);
-      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_R11021_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PROGRAM", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R11021_ -- "PROGRAM" NAME
-
-   return ffestb_R11021_;  // to lexer
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R11021_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R1102 (ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PROGRAM", t);
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_block -- Parse the BLOCK DATA statement
-
-   return ffestb_block;	 // to lexer
-
-   Make sure the statement has a valid form for the BLOCK DATA statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_block (ffelexToken t)
-{
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstBLOCK)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeNAME:
-	  if (ffesta_second_kw != FFESTR_secondDATA)
-	    goto bad_1;		/* :::::::::::::::::::: */
-	  break;
-	}
-
-      ffesta_confirmed ();
-      return (ffelexHandler) ffestb_R1111_1_;
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_blockdata -- Parse the BLOCKDATA statement
-
-   return ffestb_blockdata;  // to lexer
-
-   Make sure the statement has a valid form for the BLOCKDATA statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_blockdata (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
-	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_typeNAME:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R1111_2_;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffesta_tokens[1] = NULL;
-	  return (ffelexHandler) ffestb_R1111_2_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstBLOCKDATA)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  break;
-	}
-      ffesta_confirmed ();
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlBLOCKDATA);
-      if (*p == '\0')
-	{
-	  ffesta_tokens[1] = NULL;
-	}
-      else
-	{
-	  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_R1111_2_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R1111_1_ -- "BLOCK" "DATA"
-
-   return ffestb_R1111_1_;  // to lexer
-
-   Make sure the next token is a NAME, EOS, or SEMICOLON token.	 */
-
-static ffelexHandler
-ffestb_R1111_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R1111_2_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_tokens[1] = NULL;
-      return (ffelexHandler) ffestb_R1111_2_ (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
-      break;
-    }
-
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R1111_2_ -- "BLOCK/DATA" NAME
-
-   return ffestb_R1111_2_;  // to lexer
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R1111_2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R1111 (ffesta_tokens[1]);
-      if (ffesta_tokens[1] != NULL)
-	ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "BLOCK DATA", t);
-      break;
-    }
-
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R1212 -- Parse the CALL statement
-
-   return ffestb_R1212;	 // to lexer
-
-   Make sure the statement has a valid form for the CALL statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R1212 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCALL)
-	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 ();
-      return (ffelexHandler)
-	(*((ffelexHandler)
-	   ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
-			(ffeexprCallback) ffestb_R12121_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstCALL)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOLONCOLON:
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  break;
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-	}
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCALL);
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      next = (ffelexHandler)
-	(*((ffelexHandler)
-	   ffeexpr_lhs (ffesta_output_pool, FFEEXPR_contextSUBROUTINEREF,
-			(ffeexprCallback) ffestb_R12121_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CALL", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12121_ -- "CALL" expr
-
-   (ffestb_R12121_)  // to expression handler
-
-   Make sure the statement has a valid form for the CALL statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R12121_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R1212 (expr, ft);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CALL", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R1227 -- Parse the RETURN statement
-
-   return ffestb_R1227;	 // to lexer
-
-   Make sure the statement has a valid form for the RETURN statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R1227 (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstRETURN)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEQUALS:
-	case FFELEX_typePOINTS:
-	case FFELEX_typeCOLON:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeNAME:
-	case FFELEX_typeNUMBER:
-	  ffesta_confirmed ();
-	  break;
-
-	default:
-	  break;
-	}
-
-      return (ffelexHandler) (*((ffelexHandler)
-		     ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextRETURN,
-				  (ffeexprCallback) ffestb_R12271_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstRETURN)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEQUALS:
-	case FFELEX_typePOINTS:
-	case FFELEX_typeCOLON:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	default:
-	  break;
-	}
-      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		   FFEEXPR_contextRETURN, (ffeexprCallback) ffestb_R12271_);
-      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
-						   FFESTR_firstlRETURN);
-      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, "RETURN", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R12271_ -- "RETURN" expr
-
-   (ffestb_R12271_)  // to expression handler
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R12271_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R1227 (expr, ft);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "RETURN", t);
-      break;
-    }
-
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_construct -- Parse a construct name
-
-   return ffestb_construct;  // to lexer
-
-   Make sure the statement can have a construct name (if-then-stmt, do-stmt,
-   select-case-stmt).  */
-
-ffelexHandler
-ffestb_construct (ffelexToken t UNUSED)
-{
-  /* This handler gets invoked only when token 0 is NAME/NAMES and token 1 is
-     COLON. */
-
-  ffesta_confirmed ();
-  ffelex_set_names (TRUE);
-  return (ffelexHandler) ffestb_construct1_;
-}
-
-/* ffestb_construct1_ -- NAME COLON
-
-   return ffestb_construct1_;  // to lexer
-
-   Make sure we've got a NAME that is DO, DOWHILE, IF, SELECT, or SELECTCASE.  */
-
-static ffelexHandler
-ffestb_construct1_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_first_kw = ffestr_first (t);
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstIF:
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
-	  break;
-
-	case FFESTR_firstDO:
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
-	  break;
-
-	case FFESTR_firstDOWHILE:
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
-	  break;
-
-	case FFESTR_firstSELECT:
-	case FFESTR_firstSELECTCASE:
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      ffesta_construct_name = ffesta_tokens[0];
-      ffesta_tokens[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_construct2_;
-
-    case FFELEX_typeNAMES:
-      ffesta_first_kw = ffestr_first (t);
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstIF:
-	  if (ffelex_token_length (t) != FFESTR_firstlIF)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_if;
-	  break;
-
-	case FFESTR_firstDO:
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_do;
-	  break;
-
-	case FFESTR_firstDOWHILE:
-	  if (ffelex_token_length (t) != FFESTR_firstlDOWHILE)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_dowhile;
-	  break;
-
-	case FFESTR_firstSELECTCASE:
-	  if (ffelex_token_length (t) != FFESTR_firstlSELECTCASE)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestb_local_.construct.next = (ffelexHandler) ffestb_R809;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      ffesta_construct_name = ffesta_tokens[0];
-      ffesta_tokens[0] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_construct2_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffesta_ffebad_2st (FFEBAD_INVALID_STMT_FORM, "CONSTRUCT",
-		     ffesta_tokens[0], t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_construct2_ -- NAME COLON "DO/DOWHILE/IF/SELECT/SELECTCASE"
-
-   return ffestb_construct2_;  // to lexer
-
-   This extra step is needed to set ffesta_second_kw if the second token
-   (here) is a NAME, so DO and SELECT can continue to expect it.  */
-
-static ffelexHandler
-ffestb_construct2_ (ffelexToken t)
-{
-  if (ffelex_token_type (t) == FFELEX_typeNAME)
-    ffesta_second_kw = ffestr_second (t);
-  return (ffelexHandler) (*ffestb_local_.construct.next) (t);
-}
-
-/* ffestb_R809 -- Parse the SELECTCASE statement
-
-   return ffestb_R809;	// to lexer
-
-   Make sure the statement has a valid form for the SELECTCASE statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R809 (ffelexToken t)
-{
-  ffeTokenLength i;
-  const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstSELECT:
-	  if ((ffelex_token_type (t) != FFELEX_typeNAME)
-	      || (ffesta_second_kw != FFESTR_secondCASE))
-	    goto bad_1;		/* :::::::::::::::::::: */
-	  ffesta_confirmed ();
-	  return (ffelexHandler) ffestb_R8091_;
-
-	case FFESTR_firstSELECTCASE:
-	  return (ffelexHandler) ffestb_R8091_ (t);
-
-	default:
-	  goto bad_0;		/* :::::::::::::::::::: */
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstSELECTCASE)
-	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_firstlSELECTCASE);
-      if (*p != '\0')
-	goto bad_i;		/* :::::::::::::::::::: */
-      return (ffelexHandler) ffestb_R8091_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8091_ -- "SELECTCASE" or "SELECT" "CASE"
-
-   return ffestb_R8091_;  // to lexer
-
-   Make sure the statement has a valid form for the SELECTCASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8091_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		FFEEXPR_contextSELECTCASE, (ffeexprCallback) ffestb_R8092_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLONCOLON:
-      ffesta_confirmed ();	/* Error, but clearly intended. */
-      break;
-
-    default:
-      break;
-    }
-
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8092_ -- "SELECT/CASE" OPEN_PAREN expr
-
-   (ffestb_R8092_)  // to expression handler
-
-   Make sure the statement has a valid form for the SELECTCASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8092_ (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_.selectcase.expr = expr;
-      return (ffelexHandler) ffestb_R8093_;
-
-    default:
-      break;
-    }
-
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8093_ -- "SELECT/CASE" OPEN_PAREN expr CLOSE_PAREN
-
-   return ffestb_R8093_;  // to lexer
-
-   Make sure the statement has a valid form for the SELECTCASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8093_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R809 (ffesta_construct_name, ffestb_local_.selectcase.expr,
-		     ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffesta_construct_name != NULL)
-	{
-	  ffelex_token_kill (ffesta_construct_name);
-	  ffesta_construct_name = NULL;
-	}
-      return ffesta_zero (t);
-
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLONCOLON:
-      ffesta_confirmed ();	/* Error, but clearly intended. */
-      break;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffesta_construct_name != NULL)
-    {
-      ffelex_token_kill (ffesta_construct_name);
-      ffesta_construct_name = NULL;
-    }
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "SELECT CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R810 -- Parse the CASE statement
-
-   return ffestb_R810;	// to lexer
-
-   Make sure the statement has a valid form for the CASE statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R810 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCASE)
-	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_typeNAME:
-	  ffesta_confirmed ();
-	  if (ffesta_second_kw != FFESTR_secondDEFAULT)
-	    goto bad_1;		/* :::::::::::::::::::: */
-	  ffestb_local_.case_stmt.cases = NULL;
-	  return (ffelexHandler) ffestb_R8101_;
-
-	case FFELEX_typeOPEN_PAREN:
-	  ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
-	  return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		      FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
-	}
-
-    case FFELEX_typeNAMES:
-      switch (ffesta_first_kw)
-	{
-	case FFESTR_firstCASEDEFAULT:
-	  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_typeEOS:
-	    case FFELEX_typeSEMICOLON:
-	      ffesta_confirmed ();
-	      break;
-	    }
-	  ffestb_local_.case_stmt.cases = NULL;
-	  p = ffelex_token_text (ffesta_tokens[0])
-	    + (i = FFESTR_firstlCASEDEFAULT);
-	  if (*p == '\0')
-	    return (ffelexHandler) ffestb_R8101_ (t);
-	  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_R8102_ (t);
-
-	case FFESTR_firstCASE:
-	  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_typeOPEN_PAREN:
-	  break;
-	}
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCASE);
-      if (*p != '\0')
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffestb_local_.case_stmt.cases = ffestt_caselist_create ();
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		      FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "CASE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8101_ -- "CASE" case-selector
-
-   return ffestb_R8101_;  // to lexer
-
-   Make sure the statement has a valid form for the CASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8101_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R8102_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_tokens[1] = NULL;
-      return (ffelexHandler) ffestb_R8102_ (t);
-
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLONCOLON:
-      ffesta_confirmed ();	/* Error, but clearly intended. */
-      break;
-
-    default:
-      break;
-    }
-
-  if (ffestb_local_.case_stmt.cases != NULL)
-    ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8102_ -- "CASE" case-selector [NAME]
-
-   return ffestb_R8102_;  // to lexer
-
-   Make sure the statement has a valid form for the CASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8102_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R810 (ffestb_local_.case_stmt.cases, ffesta_tokens[1]);
-      if (ffestb_local_.case_stmt.cases != NULL)
-	ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
-      if (ffesta_tokens[1] != NULL)
-	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_.case_stmt.cases != NULL)
-    ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
-  if (ffesta_tokens[1] != NULL)
-    ffelex_token_kill (ffesta_tokens[1]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8103_ -- "CASE" OPEN_PAREN expr
-
-   (ffestb_R8103_)  // to expression handler
-
-   Make sure the statement has a valid form for the CASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8103_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
-			      ffelex_token_use (ft));
-      return (ffelexHandler) ffestb_R8101_;
-
-    case FFELEX_typeCOMMA:
-      ffestt_caselist_append (ffestb_local_.case_stmt.cases, FALSE, expr, NULL,
-			      ffelex_token_use (ft));
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		      FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
-
-    case FFELEX_typeCOLON:
-      ffestt_caselist_append (ffestb_local_.case_stmt.cases, TRUE, expr, NULL,
-			      ffelex_token_use (ft));	/* NULL second expr for
-							   now, just plug in. */
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		      FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8104_);
-
-    default:
-      break;
-    }
-
-  ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R8104_ -- "CASE" OPEN_PAREN expr COLON expr
-
-   (ffestb_R8104_)  // to expression handler
-
-   Make sure the statement has a valid form for the CASE statement.  If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R8104_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestb_local_.case_stmt.cases->previous->expr2 = expr;
-      return (ffelexHandler) ffestb_R8101_;
-
-    case FFELEX_typeCOMMA:
-      ffestb_local_.case_stmt.cases->previous->expr2 = expr;
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		      FFEEXPR_contextCASE, (ffeexprCallback) ffestb_R8103_);
-
-    default:
-      break;
-    }
-
-  ffestt_caselist_kill (ffestb_local_.case_stmt.cases);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CASE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R1001 -- Parse a FORMAT statement
-
-   return ffestb_R1001;	 // to lexer
-
-   Make sure the statement has a valid form for an FORMAT statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R1001 (ffelexToken t)
-{
-  ffesttFormatList f;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstFORMAT)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstFORMAT)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlFORMAT)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_local_.format.complained = FALSE;
-      ffestb_local_.format.f = NULL;	/* No parent yet. */
-      ffestb_local_.format.f = ffestt_formatlist_create (NULL,
-						      ffelex_token_use (t));
-      ffelex_set_names_pure (TRUE);	/* Have even free-form lexer give us
-					   NAMES. */
-      return (ffelexHandler) ffestb_R10011_;
-
-    case FFELEX_typeOPEN_ARRAY:/* "(/". */
-      ffesta_confirmed ();
-      ffestb_local_.format.complained = FALSE;
-      ffestb_local_.format.f = ffestt_formatlist_create (NULL,
-						      ffelex_token_use (t));
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      ffelex_set_names_pure (TRUE);	/* Have even free-form lexer give us
-					   NAMES. */
-      return (ffelexHandler) ffestb_R100112_;
-
-    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;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R10011_ -- "FORMAT" OPEN_PAREN expr
-
-   return ffestb_R10011_;  // to lexer
-
-   For CLOSE_PAREN, wrap up the format list and if it is the top-level one,
-   exit.  For anything else, pass it to _2_.  */
-
-static ffelexHandler
-ffestb_R10011_ (ffelexToken t)
-{
-  ffesttFormatList f;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      break;
-
-    default:
-      return (ffelexHandler) ffestb_R10012_ (t);
-    }
-
-  /* If we have a format we're working on, continue working on it. */
-
-  f = ffestb_local_.format.f->u.root.parent;
-
-  if (f != NULL)
-    {
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-    }
-
-  return (ffelexHandler) ffestb_R100114_;
-}
-
-/* ffestb_R10012_ -- "FORMAT" OPEN_PAREN [format-item-list]
-
-   return ffestb_R10012_;  // to lexer
-
-   The initial state for a format-item.	 Here, just handle the initial
-   number, sign for number, or run-time expression.  Also handle spurious
-   comma, close-paren (indicating spurious comma), close-array (like
-   close-paren but preceded by slash), and quoted strings.  */
-
-static ffelexHandler
-ffestb_R10012_ (ffelexToken t)
-{
-  unsigned long unsigned_val;
-  ffesttFormatList f;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_ANGLE:
-      ffesta_confirmed ();
-      ffestb_local_.format.pre.t = ffelex_token_use (t);
-      ffelex_set_names_pure (FALSE);
-      if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
-	{
-	  ffestb_local_.format.complained = TRUE;
-	  ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100115_);
-
-    case FFELEX_typeNUMBER:
-      ffestb_local_.format.sign = FALSE;	/* No sign present. */
-      ffestb_local_.format.pre.present = TRUE;
-      ffestb_local_.format.pre.rtexpr = FALSE;
-      ffestb_local_.format.pre.t = ffelex_token_use (t);
-      ffestb_local_.format.pre.u.unsigned_val = unsigned_val
-	= strtoul (ffelex_token_text (t), NULL, 10);
-      ffelex_set_expecting_hollerith (unsigned_val, '\0',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));
-      return (ffelexHandler) ffestb_R10014_;
-
-    case FFELEX_typePLUS:
-      ffestb_local_.format.sign = TRUE;	/* Positive. */
-      ffestb_local_.format.pre.t = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R10013_;
-
-    case FFELEX_typeMINUS:
-      ffestb_local_.format.sign = FALSE;	/* Negative. */
-      ffestb_local_.format.pre.t = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R10013_;
-
-    case FFELEX_typeCOLON:
-    case FFELEX_typeCOLONCOLON:/* "::". */
-    case FFELEX_typeSLASH:
-    case FFELEX_typeCONCAT:	/* "//". */
-    case FFELEX_typeNAMES:
-    case FFELEX_typeDOLLAR:
-    case FFELEX_typeOPEN_PAREN:
-    case FFELEX_typeOPEN_ARRAY:/* "(/". */
-      ffestb_local_.format.sign = FALSE;	/* No sign present. */
-      ffestb_local_.format.pre.present = FALSE;
-      ffestb_local_.format.pre.rtexpr = FALSE;
-      ffestb_local_.format.pre.t = NULL;
-      ffestb_local_.format.pre.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R10014_ (t);
-
-    case FFELEX_typeCOMMA:
-      ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-      return (ffelexHandler) ffestb_R10012_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffebad_start (FFEBAD_FORMAT_EXTRA_COMMA);
-      ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-      ffebad_finish ();
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeCLOSE_ARRAY:	/* "/)". */
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
-      for (f = ffestb_local_.format.f;
-	   f->u.root.parent != NULL;
-	   f = f->u.root.parent->next)
-	;
-      ffestb_local_.format.f = f;
-      return (ffelexHandler) ffestb_R100114_ (t);
-
-    case FFELEX_typeQUOTE:
-      if (ffe_is_vxt ())
-	break;			/* Error, probably something like FORMAT("17)
-				   = X. */
-      ffelex_set_expecting_hollerith (-1, '\"',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));	/* Don't have to unset
-									   this one. */
-      return (ffelexHandler) ffestb_R100113_;
-
-    case FFELEX_typeAPOSTROPHE:
-#if 0				/* No apparent need for this, and not killed
-				   anywhere. */
-      ffesta_tokens[1] = ffelex_token_use (t);
-#endif
-      ffelex_set_expecting_hollerith (-1, '\'',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));	/* Don't have to unset
-									   this one. */
-      return (ffelexHandler) ffestb_R100113_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-  ffestt_formatlist_kill (ffestb_local_.format.f);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R10013_ -- "FORMAT" OPEN_PAREN [format-item-list] PLUS/MINUS
-
-   return ffestb_R10013_;  // to lexer
-
-   Expect a NUMBER or complain about and then ignore the PLUS/MINUS.  */
-
-static ffelexHandler
-ffestb_R10013_ (ffelexToken t)
-{
-  unsigned long unsigned_val;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestb_local_.format.pre.present = TRUE;
-      ffestb_local_.format.pre.rtexpr = FALSE;
-      unsigned_val = strtoul (ffelex_token_text (t), NULL, 10);
-      ffestb_local_.format.pre.u.signed_val = ffestb_local_.format.sign
-	? unsigned_val : -unsigned_val;
-      ffestb_local_.format.sign = TRUE;	/* Sign present. */
-      return (ffelexHandler) ffestb_R10014_;
-
-    default:
-      ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
-      ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		   ffelex_token_where_column (ffestb_local_.format.pre.t));
-      ffebad_finish ();
-      ffelex_token_kill (ffestb_local_.format.pre.t);
-      return (ffelexHandler) ffestb_R10012_ (t);
-    }
-}
-
-/* ffestb_R10014_ -- "FORMAT" OPEN_PAREN [format-item-list] [[+/-] NUMBER]
-
-   return ffestb_R10014_;  // to lexer
-
-   Here is where we expect to see the actual NAMES, COLON, SLASH, OPEN_PAREN,
-   OPEN_ARRAY, COLONCOLON, CONCAT, DOLLAR, or HOLLERITH that identifies what
-   kind of format-item we're dealing with.  But if we see a NUMBER instead, it
-   means free-form spaces number like "5 6 X", so scale the current number
-   accordingly and reenter this state.	(I really wouldn't be surprised if
-   they change this spacing rule in the F90 spec so that you can't embed
-   spaces within numbers or within keywords like BN in a free-source-form
-   program.)  */
-
-static ffelexHandler
-ffestb_R10014_ (ffelexToken t)
-{
-  ffesttFormatList f;
-  ffeTokenLength i;
-  const char *p;
-  ffestrFormat kw;
-
-  ffelex_set_expecting_hollerith (0, '\0',
-				  ffewhere_line_unknown (),
-				  ffewhere_column_unknown ());
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeHOLLERITH:
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeR1016;
-      f->t = ffelex_token_use (t);
-      ffelex_token_kill (ffestb_local_.format.pre.t);	/* It WAS present! */
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeNUMBER:
-      assert (ffestb_local_.format.pre.present);
-      ffesta_confirmed ();
-      if (ffestb_local_.format.pre.rtexpr)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  return (ffelexHandler) ffestb_R10014_;
-	}
-      if (ffestb_local_.format.sign)
-	{
-	  for (i = ffelex_token_length (t) + 1; i > 0; --i)
-	    ffestb_local_.format.pre.u.signed_val *= 10;
-	  ffestb_local_.format.pre.u.signed_val += strtoul (ffelex_token_text (t),
-							    NULL, 10);
-	}
-      else
-	{
-	  for (i = ffelex_token_length (t) + 1; i > 0; --i)
-	    ffestb_local_.format.pre.u.unsigned_val *= 10;
-	  ffestb_local_.format.pre.u.unsigned_val += strtoul (ffelex_token_text (t),
-							      NULL, 10);
-	  ffelex_set_expecting_hollerith (ffestb_local_.format.pre.u.unsigned_val,
-					  '\0',
-					  ffelex_token_where_line (t),
-					  ffelex_token_where_column (t));
-	}
-      return (ffelexHandler) ffestb_R10014_;
-
-    case FFELEX_typeCOLONCOLON:	/* "::". */
-      if (ffestb_local_.format.pre.present)
-	{
-	  ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
-			    ffestb_local_.format.pre.t);
-	  ffelex_token_kill (ffestb_local_.format.pre.t);
-	  ffestb_local_.format.pre.present = FALSE;
-	}
-      else
-	{
-	  f = ffestt_formatlist_append (ffestb_local_.format.f);
-	  f->type = FFESTP_formattypeCOLON;
-	  f->t = ffelex_token_use (t);
-	  f->u.R1010.val.present = FALSE;
-	  f->u.R1010.val.rtexpr = FALSE;
-	  f->u.R1010.val.t = NULL;
-	  f->u.R1010.val.u.unsigned_val = 1;
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeCOLON;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R100112_;
-
-    case FFELEX_typeCOLON:
-      if (ffestb_local_.format.pre.present)
-	{
-	  ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_COLON_SPEC,
-			    ffestb_local_.format.pre.t);
-	  ffelex_token_kill (ffestb_local_.format.pre.t);
-	  return (ffelexHandler) ffestb_R100112_;
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeCOLON;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R100112_;
-
-    case FFELEX_typeCONCAT:	/* "//". */
-      if (ffestb_local_.format.sign)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
-	  ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		    ffelex_token_where_column (ffestb_local_.format.pre.t));
-	  ffebad_finish ();
-	  ffestb_local_.format.pre.u.unsigned_val
-	    = (ffestb_local_.format.pre.u.signed_val < 0)
-	    ? -ffestb_local_.format.pre.u.signed_val
-	    : ffestb_local_.format.pre.u.signed_val;
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val = ffestb_local_.format.pre;
-      ffestb_local_.format.pre.present = FALSE;
-      ffestb_local_.format.pre.rtexpr = FALSE;
-      ffestb_local_.format.pre.t = NULL;
-      ffestb_local_.format.pre.u.unsigned_val = 1;
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val = ffestb_local_.format.pre;
-      return (ffelexHandler) ffestb_R100112_;
-
-    case FFELEX_typeSLASH:
-      if (ffestb_local_.format.sign)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
-	  ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		    ffelex_token_where_column (ffestb_local_.format.pre.t));
-	  ffebad_finish ();
-	  ffestb_local_.format.pre.u.unsigned_val
-	    = (ffestb_local_.format.pre.u.signed_val < 0)
-	    ? -ffestb_local_.format.pre.u.signed_val
-	    : ffestb_local_.format.pre.u.signed_val;
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val = ffestb_local_.format.pre;
-      return (ffelexHandler) ffestb_R100112_;
-
-    case FFELEX_typeOPEN_PAREN:
-      if (ffestb_local_.format.sign)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
-	  ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		    ffelex_token_where_column (ffestb_local_.format.pre.t));
-	  ffebad_finish ();
-	  ffestb_local_.format.pre.u.unsigned_val
-	    = (ffestb_local_.format.pre.u.signed_val < 0)
-	    ? -ffestb_local_.format.pre.u.signed_val
-	    : ffestb_local_.format.pre.u.signed_val;
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeFORMAT;
-      f->t = ffelex_token_use (t);
-      f->u.R1003D.R1004 = ffestb_local_.format.pre;
-      f->u.R1003D.format = ffestb_local_.format.f
-	= ffestt_formatlist_create (f, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_R10011_;
-
-    case FFELEX_typeOPEN_ARRAY:/* "(/". */
-      if (ffestb_local_.format.sign)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
-	  ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		    ffelex_token_where_column (ffestb_local_.format.pre.t));
-	  ffebad_finish ();
-	  ffestb_local_.format.pre.u.unsigned_val
-	    = (ffestb_local_.format.pre.u.signed_val < 0)
-	    ? -ffestb_local_.format.pre.u.signed_val
-	    : ffestb_local_.format.pre.u.signed_val;
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeFORMAT;
-      f->t = ffelex_token_use (t);
-      f->u.R1003D.R1004 = ffestb_local_.format.pre;
-      f->u.R1003D.format = ffestb_local_.format.f
-	= ffestt_formatlist_create (f, ffelex_token_use (t));
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R100112_;
-
-    case FFELEX_typeCLOSE_ARRAY:	/* "/)". */
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val = ffestb_local_.format.pre;
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeQUOTE:
-      if (ffe_is_vxt ())
-	break;			/* A totally bad character in a VXT FORMAT. */
-      ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
-      ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		   ffelex_token_where_column (ffestb_local_.format.pre.t));
-      ffebad_finish ();
-      ffelex_token_kill (ffestb_local_.format.pre.t);
-      ffesta_confirmed ();
-#if 0				/* No apparent need for this, and not killed
-				   anywhere. */
-      ffesta_tokens[1] = ffelex_token_use (t);
-#endif
-      ffelex_set_expecting_hollerith (-1, '\"',
-				      ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));	/* Don't have to unset
-									   this one. */
-      return (ffelexHandler) ffestb_R100113_;
-
-    case FFELEX_typeAPOSTROPHE:
-      ffesta_confirmed ();
-      ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
-      ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		   ffelex_token_where_column (ffestb_local_.format.pre.t));
-      ffebad_finish ();
-      ffelex_token_kill (ffestb_local_.format.pre.t);
-#if 0				/* No apparent need for this, and not killed
-				   anywhere. */
-      ffesta_tokens[1] = ffelex_token_use (t);
-#endif
-      ffelex_set_expecting_hollerith (-1, '\'', ffelex_token_where_line (t),
-				      ffelex_token_where_column (t));	/* Don't have to unset
-									   this one. */
-      return (ffelexHandler) ffestb_R100113_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
-      for (f = ffestb_local_.format.f;
-	   f->u.root.parent != NULL;
-	   f = f->u.root.parent->next)
-	;
-      ffestb_local_.format.f = f;
-      ffelex_token_kill (ffestb_local_.format.pre.t);
-      return (ffelexHandler) ffestb_R100114_ (t);
-
-    case FFELEX_typeDOLLAR:
-      ffestb_local_.format.t = ffelex_token_use (t);
-      if (ffestb_local_.format.pre.present)
-	ffesta_confirmed ();	/* Number preceding this invalid elsewhere. */
-      ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
-      return (ffelexHandler) ffestb_R10015_;
-
-    case FFELEX_typeNAMES:
-      kw = ffestr_format (t);
-      ffestb_local_.format.t = ffelex_token_use (t);
-      switch (kw)
-	{
-	case FFESTR_formatI:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeI;
-	  i = FFESTR_formatlI;
-	  break;
-
-	case FFESTR_formatB:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeB;
-	  i = FFESTR_formatlB;
-	  break;
-
-	case FFESTR_formatO:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeO;
-	  i = FFESTR_formatlO;
-	  break;
-
-	case FFESTR_formatZ:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeZ;
-	  i = FFESTR_formatlZ;
-	  break;
-
-	case FFESTR_formatF:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeF;
-	  i = FFESTR_formatlF;
-	  break;
-
-	case FFESTR_formatE:
-	  ffestb_local_.format.current = FFESTP_formattypeE;
-	  i = FFESTR_formatlE;
-	  break;
-
-	case FFESTR_formatEN:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeEN;
-	  i = FFESTR_formatlEN;
-	  break;
-
-	case FFESTR_formatG:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeG;
-	  i = FFESTR_formatlG;
-	  break;
-
-	case FFESTR_formatL:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeL;
-	  i = FFESTR_formatlL;
-	  break;
-
-	case FFESTR_formatA:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeA;
-	  i = FFESTR_formatlA;
-	  break;
-
-	case FFESTR_formatD:
-	  ffestb_local_.format.current = FFESTP_formattypeD;
-	  i = FFESTR_formatlD;
-	  break;
-
-	case FFESTR_formatQ:
-	  ffestb_local_.format.current = FFESTP_formattypeQ;
-	  i = FFESTR_formatlQ;
-	  break;
-
-	case FFESTR_formatDOLLAR:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeDOLLAR;
-	  i = FFESTR_formatlDOLLAR;
-	  break;
-
-	case FFESTR_formatP:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeP;
-	  i = FFESTR_formatlP;
-	  break;
-
-	case FFESTR_formatT:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeT;
-	  i = FFESTR_formatlT;
-	  break;
-
-	case FFESTR_formatTL:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeTL;
-	  i = FFESTR_formatlTL;
-	  break;
-
-	case FFESTR_formatTR:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeTR;
-	  i = FFESTR_formatlTR;
-	  break;
-
-	case FFESTR_formatX:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeX;
-	  i = FFESTR_formatlX;
-	  break;
-
-	case FFESTR_formatS:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeS;
-	  i = FFESTR_formatlS;
-	  break;
-
-	case FFESTR_formatSP:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeSP;
-	  i = FFESTR_formatlSP;
-	  break;
-
-	case FFESTR_formatSS:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeSS;
-	  i = FFESTR_formatlSS;
-	  break;
-
-	case FFESTR_formatBN:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeBN;
-	  i = FFESTR_formatlBN;
-	  break;
-
-	case FFESTR_formatBZ:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeBZ;
-	  i = FFESTR_formatlBZ;
-	  break;
-
-	case FFESTR_formatH:	/* Error, either "H" or "<expr>H". */
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeH;
-	  i = FFESTR_formatlH;
-	  break;
-
-	case FFESTR_formatPD:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_subr_R1001_append_p_ ();
-	  ffestb_local_.format.t = ffelex_token_name_from_names (t,
-							FFESTR_formatlP, 1);
-	  ffestb_local_.format.sign = FALSE;
-	  ffestb_local_.format.pre.present = FALSE;
-	  ffestb_local_.format.pre.rtexpr = FALSE;
-	  ffestb_local_.format.pre.t = NULL;
-	  ffestb_local_.format.pre.u.unsigned_val = 1;
-	  ffestb_local_.format.current = FFESTP_formattypeD;
-	  i = FFESTR_formatlPD;
-	  break;
-
-	case FFESTR_formatPE:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_subr_R1001_append_p_ ();
-	  ffestb_local_.format.t = ffelex_token_name_from_names (t,
-							FFESTR_formatlP, 1);
-	  ffestb_local_.format.sign = FALSE;
-	  ffestb_local_.format.pre.present = FALSE;
-	  ffestb_local_.format.pre.rtexpr = FALSE;
-	  ffestb_local_.format.pre.t = NULL;
-	  ffestb_local_.format.pre.u.unsigned_val = 1;
-	  ffestb_local_.format.current = FFESTP_formattypeE;
-	  i = FFESTR_formatlPE;
-	  break;
-
-	case FFESTR_formatPEN:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_subr_R1001_append_p_ ();
-	  ffestb_local_.format.t = ffelex_token_name_from_names (t,
-							FFESTR_formatlP, 1);
-	  ffestb_local_.format.sign = FALSE;
-	  ffestb_local_.format.pre.present = FALSE;
-	  ffestb_local_.format.pre.rtexpr = FALSE;
-	  ffestb_local_.format.pre.t = NULL;
-	  ffestb_local_.format.pre.u.unsigned_val = 1;
-	  ffestb_local_.format.current = FFESTP_formattypeEN;
-	  i = FFESTR_formatlPEN;
-	  break;
-
-	case FFESTR_formatPF:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_subr_R1001_append_p_ ();
-	  ffestb_local_.format.t = ffelex_token_name_from_names (t,
-							FFESTR_formatlP, 1);
-	  ffestb_local_.format.sign = FALSE;
-	  ffestb_local_.format.pre.present = FALSE;
-	  ffestb_local_.format.pre.rtexpr = FALSE;
-	  ffestb_local_.format.pre.t = NULL;
-	  ffestb_local_.format.pre.u.unsigned_val = 1;
-	  ffestb_local_.format.current = FFESTP_formattypeF;
-	  i = FFESTR_formatlPF;
-	  break;
-
-	case FFESTR_formatPG:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_subr_R1001_append_p_ ();
-	  ffestb_local_.format.t = ffelex_token_name_from_names (t,
-							FFESTR_formatlP, 1);
-	  ffestb_local_.format.sign = FALSE;
-	  ffestb_local_.format.pre.present = FALSE;
-	  ffestb_local_.format.pre.rtexpr = FALSE;
-	  ffestb_local_.format.pre.t = NULL;
-	  ffestb_local_.format.pre.u.unsigned_val = 1;
-	  ffestb_local_.format.current = FFESTP_formattypeG;
-	  i = FFESTR_formatlPG;
-	  break;
-
-	default:
-	  if (ffestb_local_.format.pre.present)
-	    ffesta_confirmed ();/* Number preceding this invalid elsewhere. */
-	  ffestb_local_.format.current = FFESTP_formattypeNone;
-	  p = strpbrk (ffelex_token_text (t), "0123456789");
-	  if (p == NULL)
-	    i = ffelex_token_length (t);
-	  else
-	    i = p - ffelex_token_text (t);
-	  break;
-	}
-      p = ffelex_token_text (t) + i;
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R10015_;
-      if (! ISDIGIT (*p))
-	{
-	  if (ffestb_local_.format.current == FFESTP_formattypeH)
-	    p = strpbrk (p, "0123456789");
-	  else
-	    {
-	      p = NULL;
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	    }
-	  if (p == NULL)
-	    return (ffelexHandler) ffestb_R10015_;
-	  i = p - ffelex_token_text (t);	/* Collect digits. */
-	}
-      ffestb_local_.format.post.present = TRUE;
-      ffestb_local_.format.post.rtexpr = FALSE;
-      ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
-      ffestb_local_.format.post.u.unsigned_val
-	= strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
-      p += ffelex_token_length (ffestb_local_.format.post.t);
-      i += ffelex_token_length (ffestb_local_.format.post.t);
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R10016_;
-      if ((kw != FFESTR_formatP) ||
-	  !ffelex_is_firstnamechar ((unsigned char)*p))
-	{
-	  if (ffestb_local_.format.current != FFESTP_formattypeH)
-	    ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
-	  return (ffelexHandler) ffestb_R10016_;
-	}
-
-      /* Here we have [number]P[number][text].	Treat as
-	 [number]P,[number][text]. */
-
-      ffestb_subr_R1001_append_p_ ();
-      t = ffestb_local_.format.t = ffelex_token_names_from_names (t, i, 0);
-      ffestb_local_.format.sign = FALSE;
-      ffestb_local_.format.pre = ffestb_local_.format.post;
-      kw = ffestr_format (t);
-      switch (kw)
-	{			/* Only a few possibilities here. */
-	case FFESTR_formatD:
-	  ffestb_local_.format.current = FFESTP_formattypeD;
-	  i = FFESTR_formatlD;
-	  break;
-
-	case FFESTR_formatE:
-	  ffestb_local_.format.current = FFESTP_formattypeE;
-	  i = FFESTR_formatlE;
-	  break;
-
-	case FFESTR_formatEN:
-	  ffestb_local_.format.current = FFESTP_formattypeEN;
-	  i = FFESTR_formatlEN;
-	  break;
-
-	case FFESTR_formatF:
-	  ffestb_local_.format.current = FFESTP_formattypeF;
-	  i = FFESTR_formatlF;
-	  break;
-
-	case FFESTR_formatG:
-	  ffestb_local_.format.current = FFESTP_formattypeG;
-	  i = FFESTR_formatlG;
-	  break;
-
-	default:
-	  ffebad_start (FFEBAD_FORMAT_P_NOCOMMA);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  ffestb_local_.format.current = FFESTP_formattypeNone;
-	  p = strpbrk (ffelex_token_text (t), "0123456789");
-	  if (p == NULL)
-	    i = ffelex_token_length (t);
-	  else
-	    i = p - ffelex_token_text (t);
-	}
-      p = ffelex_token_text (t) + i;
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R10015_;
-      if (! ISDIGIT (*p))
-	{
-	  ffestb_local_.format.current = FFESTP_formattypeNone;
-	  p = strpbrk (p, "0123456789");
-	  if (p == NULL)
-	    return (ffelexHandler) ffestb_R10015_;
-	  i = p - ffelex_token_text (t);	/* Collect digits anyway. */
-	}
-      ffestb_local_.format.post.present = TRUE;
-      ffestb_local_.format.post.rtexpr = FALSE;
-      ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
-      ffestb_local_.format.post.u.unsigned_val
-	= strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
-      p += ffelex_token_length (ffestb_local_.format.post.t);
-      i += ffelex_token_length (ffestb_local_.format.post.t);
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R10016_;
-      ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
-      return (ffelexHandler) ffestb_R10016_;
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-  if (ffestb_local_.format.pre.present)
-    ffelex_token_kill (ffestb_local_.format.pre.t);
-  ffestt_formatlist_kill (ffestb_local_.format.f);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R10015_ -- [[+/-] NUMBER] NAMES
-
-   return ffestb_R10015_;  // to lexer
-
-   Here we've gotten at least the initial mnemonic for the edit descriptor.
-   We expect either a NUMBER, for the post-mnemonic value, a NAMES, for
-   further clarification (in free-form only, sigh) of the mnemonic, or
-   anything else.  In all cases we go to _6_, with the difference that for
-   NUMBER and NAMES we send the next token rather than the current token.  */
-
-static ffelexHandler
-ffestb_R10015_ (ffelexToken t)
-{
-  bool split_pea;		/* New NAMES requires splitting kP from new
-				   edit desc. */
-  ffestrFormat kw;
-  const char *p;
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_ANGLE:
-      ffesta_confirmed ();
-      ffestb_local_.format.post.t = ffelex_token_use (t);
-      ffelex_set_names_pure (FALSE);
-      if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
-	{
-	  ffestb_local_.format.complained = TRUE;
-	  ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100116_);
-
-    case FFELEX_typeNUMBER:
-      ffestb_local_.format.post.present = TRUE;
-      ffestb_local_.format.post.rtexpr = FALSE;
-      ffestb_local_.format.post.t = ffelex_token_use (t);
-      ffestb_local_.format.post.u.unsigned_val
-	= strtoul (ffelex_token_text (t), NULL, 10);
-      return (ffelexHandler) ffestb_R10016_;
-
-    case FFELEX_typeNAMES:
-      ffesta_confirmed ();	/* NAMES " " NAMES invalid elsewhere in
-				   free-form. */
-      kw = ffestr_format (t);
-      switch (ffestb_local_.format.current)
-	{
-	case FFESTP_formattypeP:
-	  split_pea = TRUE;
-	  break;
-
-	case FFESTP_formattypeH:	/* An error, maintain this indicator. */
-	  kw = FFESTR_formatNone;
-	  split_pea = FALSE;
-	  break;
-
-	default:
-	  split_pea = FALSE;
-	  break;
-	}
-
-      switch (kw)
-	{
-	case FFESTR_formatF:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeP:
-	      ffestb_local_.format.current = FFESTP_formattypeF;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlF;
-	  break;
-
-	case FFESTR_formatE:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeP:
-	      ffestb_local_.format.current = FFESTP_formattypeE;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlE;
-	  break;
-
-	case FFESTR_formatEN:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeP:
-	      ffestb_local_.format.current = FFESTP_formattypeEN;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlEN;
-	  break;
-
-	case FFESTR_formatG:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeP:
-	      ffestb_local_.format.current = FFESTP_formattypeG;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlG;
-	  break;
-
-	case FFESTR_formatL:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeT:
-	      ffestb_local_.format.current = FFESTP_formattypeTL;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlL;
-	  break;
-
-	case FFESTR_formatD:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeP:
-	      ffestb_local_.format.current = FFESTP_formattypeD;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlD;
-	  break;
-
-	case FFESTR_formatS:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeS:
-	      ffestb_local_.format.current = FFESTP_formattypeSS;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlS;
-	  break;
-
-	case FFESTR_formatP:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeS:
-	      ffestb_local_.format.current = FFESTP_formattypeSP;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlP;
-	  break;
-
-	case FFESTR_formatR:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeT:
-	      ffestb_local_.format.current = FFESTP_formattypeTR;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlR;
-	  break;
-
-	case FFESTR_formatZ:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeB:
-	      ffestb_local_.format.current = FFESTP_formattypeBZ;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlZ;
-	  break;
-
-	case FFESTR_formatN:
-	  switch (ffestb_local_.format.current)
-	    {
-	    case FFESTP_formattypeE:
-	      ffestb_local_.format.current = FFESTP_formattypeEN;
-	      break;
-
-	    case FFESTP_formattypeB:
-	      ffestb_local_.format.current = FFESTP_formattypeBN;
-	      break;
-
-	    default:
-	      ffestb_local_.format.current = FFESTP_formattypeNone;
-	      break;
-	    }
-	  i = FFESTR_formatlN;
-	  break;
-
-	default:
-	  if (ffestb_local_.format.current != FFESTP_formattypeH)
-	    ffestb_local_.format.current = FFESTP_formattypeNone;
-	  split_pea = FALSE;	/* Go ahead and let the P be in the party. */
-	  p = strpbrk (ffelex_token_text (t), "0123456789");
-	  if (p == NULL)
-	    i = ffelex_token_length (t);
-	  else
-	    i = p - ffelex_token_text (t);
-	}
-
-      if (split_pea)
-	{
-	  ffestb_subr_R1001_append_p_ ();
-	  ffestb_local_.format.t = ffelex_token_use (t);
-	  ffestb_local_.format.sign = FALSE;
-	  ffestb_local_.format.pre.present = FALSE;
-	  ffestb_local_.format.pre.rtexpr = FALSE;
-	  ffestb_local_.format.pre.t = NULL;
-	  ffestb_local_.format.pre.u.unsigned_val = 1;
-	}
-
-      p = ffelex_token_text (t) + i;
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R10015_;
-      if (! ISDIGIT (*p))
-	{
-	  ffestb_local_.format.current = FFESTP_formattypeNone;
-	  p = strpbrk (p, "0123456789");
-	  if (p == NULL)
-	    return (ffelexHandler) ffestb_R10015_;
-	  i = p - ffelex_token_text (t);	/* Collect digits anyway. */
-	}
-      ffestb_local_.format.post.present = TRUE;
-      ffestb_local_.format.post.rtexpr = FALSE;
-      ffestb_local_.format.post.t = ffelex_token_number_from_names (t, i);
-      ffestb_local_.format.post.u.unsigned_val
-	= strtoul (ffelex_token_text (ffestb_local_.format.post.t), NULL, 10);
-      p += ffelex_token_length (ffestb_local_.format.post.t);
-      i += ffelex_token_length (ffestb_local_.format.post.t);
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R10016_;
-      ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
-      return (ffelexHandler) ffestb_R10016_;
-
-    default:
-      ffestb_local_.format.post.present = FALSE;
-      ffestb_local_.format.post.rtexpr = FALSE;
-      ffestb_local_.format.post.t = NULL;
-      ffestb_local_.format.post.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R10016_ (t);
-    }
-}
-
-/* ffestb_R10016_ -- [[+/-] NUMBER] NAMES NUMBER
-
-   return ffestb_R10016_;  // to lexer
-
-   Expect a PERIOD here.  Maybe find a NUMBER to append to the current
-   number, in which case return to this state.	Maybe find a NAMES to switch
-   from a kP descriptor to a new descriptor (else the NAMES is spurious),
-   in which case generator the P item and go to state _4_.  Anything
-   else, pass token on to state _8_.  */
-
-static ffelexHandler
-ffestb_R10016_ (ffelexToken t)
-{
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typePERIOD:
-      return (ffelexHandler) ffestb_R10017_;
-
-    case FFELEX_typeNUMBER:
-      assert (ffestb_local_.format.post.present);
-      ffesta_confirmed ();
-      if (ffestb_local_.format.post.rtexpr)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  return (ffelexHandler) ffestb_R10016_;
-	}
-      for (i = ffelex_token_length (t) + 1; i > 0; --i)
-	ffestb_local_.format.post.u.unsigned_val *= 10;
-      ffestb_local_.format.post.u.unsigned_val += strtoul (ffelex_token_text (t),
-							   NULL, 10);
-      return (ffelexHandler) ffestb_R10016_;
-
-    case FFELEX_typeNAMES:
-      ffesta_confirmed ();	/* NUMBER " " NAMES invalid elsewhere. */
-      if (ffestb_local_.format.current != FFESTP_formattypeP)
-	{
-	  ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
-	  return (ffelexHandler) ffestb_R10016_;
-	}
-      ffestb_subr_R1001_append_p_ ();
-      ffestb_local_.format.sign = FALSE;
-      ffestb_local_.format.pre = ffestb_local_.format.post;
-      return (ffelexHandler) ffestb_R10014_ (t);
-
-    default:
-      ffestb_local_.format.dot.present = FALSE;
-      ffestb_local_.format.dot.rtexpr = FALSE;
-      ffestb_local_.format.dot.t = NULL;
-      ffestb_local_.format.dot.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R10018_ (t);
-    }
-}
-
-/* ffestb_R10017_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD
-
-   return ffestb_R10017_;  // to lexer
-
-   Here we've gotten the period following the edit descriptor.
-   We expect either a NUMBER, for the dot value, or something else, which
-   probably means we're not even close to being in a real FORMAT statement.  */
-
-static ffelexHandler
-ffestb_R10017_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_ANGLE:
-      ffestb_local_.format.dot.t = ffelex_token_use (t);
-      ffelex_set_names_pure (FALSE);
-      if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
-	{
-	  ffestb_local_.format.complained = TRUE;
-	  ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100117_);
-
-    case FFELEX_typeNUMBER:
-      ffestb_local_.format.dot.present = TRUE;
-      ffestb_local_.format.dot.rtexpr = FALSE;
-      ffestb_local_.format.dot.t = ffelex_token_use (t);
-      ffestb_local_.format.dot.u.unsigned_val
-	= strtoul (ffelex_token_text (t), NULL, 10);
-      return (ffelexHandler) ffestb_R10018_;
-
-    default:
-      ffelex_token_kill (ffestb_local_.format.t);
-      if (ffestb_local_.format.pre.present)
-	ffelex_token_kill (ffestb_local_.format.pre.t);
-      if (ffestb_local_.format.post.present)
-	ffelex_token_kill (ffestb_local_.format.post.t);
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_DOT, t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R10018_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER
-
-   return ffestb_R10018_;  // to lexer
-
-   Expect a NAMES here, which must begin with "E" to be valid.	Maybe find a
-   NUMBER to append to the current number, in which case return to this state.
-   Anything else, pass token on to state _10_.	*/
-
-static ffelexHandler
-ffestb_R10018_ (ffelexToken t)
-{
-  ffeTokenLength i;
-  const char *p;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      assert (ffestb_local_.format.dot.present);
-      ffesta_confirmed ();
-      if (ffestb_local_.format.dot.rtexpr)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  return (ffelexHandler) ffestb_R10018_;
-	}
-      for (i = ffelex_token_length (t) + 1; i > 0; --i)
-	ffestb_local_.format.dot.u.unsigned_val *= 10;
-      ffestb_local_.format.dot.u.unsigned_val += strtoul (ffelex_token_text (t),
-							  NULL, 10);
-      return (ffelexHandler) ffestb_R10018_;
-
-    case FFELEX_typeNAMES:
-      if (!ffesrc_char_match_init (*(p = ffelex_token_text (t)), 'E', 'e'))
-	{
-	  ffesta_ffebad_1t (FFEBAD_FORMAT_TEXT_IN_NUMBER, t);
-	  return (ffelexHandler) ffestb_R10018_;
-	}
-      if (*++p == '\0')
-	return (ffelexHandler) ffestb_R10019_;	/* Go get NUMBER. */
-      i = 1;
-      if (! ISDIGIT (*p))
-	{
-	  ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, 1, NULL);
-	  return (ffelexHandler) ffestb_R10018_;
-	}
-      ffestb_local_.format.exp.present = TRUE;
-      ffestb_local_.format.exp.rtexpr = FALSE;
-      ffestb_local_.format.exp.t = ffelex_token_number_from_names (t, i);
-      ffestb_local_.format.exp.u.unsigned_val
-	= strtoul (ffelex_token_text (ffestb_local_.format.exp.t), NULL, 10);
-      p += ffelex_token_length (ffestb_local_.format.exp.t);
-      i += ffelex_token_length (ffestb_local_.format.exp.t);
-      if (*p == '\0')
-	return (ffelexHandler) ffestb_R100110_;
-      ffesta_ffebad_1p (FFEBAD_FORMAT_TEXT_IN_NUMBER, t, i, NULL);
-      return (ffelexHandler) ffestb_R100110_;
-
-    default:
-      ffestb_local_.format.exp.present = FALSE;
-      ffestb_local_.format.exp.rtexpr = FALSE;
-      ffestb_local_.format.exp.t = NULL;
-      ffestb_local_.format.exp.u.unsigned_val = 1;
-      return (ffelexHandler) ffestb_R100110_ (t);
-    }
-}
-
-/* ffestb_R10019_ -- [[+/-] NUMBER] NAMES NUMBER PERIOD NUMBER "E"
-
-   return ffestb_R10019_;  // to lexer
-
-   Here we've gotten the "E" following the edit descriptor.
-   We expect either a NUMBER, for the exponent value, or something else.  */
-
-static ffelexHandler
-ffestb_R10019_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_ANGLE:
-      ffestb_local_.format.exp.t = ffelex_token_use (t);
-      ffelex_set_names_pure (FALSE);
-      if (!ffesta_seen_first_exec && !ffestb_local_.format.complained)
-	{
-	  ffestb_local_.format.complained = TRUE;
-	  ffebad_start (FFEBAD_FORMAT_EXPR_SPEC);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	}
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFORMAT, (ffeexprCallback) ffestb_R100118_);
-
-    case FFELEX_typeNUMBER:
-      ffestb_local_.format.exp.present = TRUE;
-      ffestb_local_.format.exp.rtexpr = FALSE;
-      ffestb_local_.format.exp.t = ffelex_token_use (t);
-      ffestb_local_.format.exp.u.unsigned_val
-	= strtoul (ffelex_token_text (t), NULL, 10);
-      return (ffelexHandler) ffestb_R100110_;
-
-    default:
-      ffelex_token_kill (ffestb_local_.format.t);
-      if (ffestb_local_.format.pre.present)
-	ffelex_token_kill (ffestb_local_.format.pre.t);
-      if (ffestb_local_.format.post.present)
-	ffelex_token_kill (ffestb_local_.format.post.t);
-      if (ffestb_local_.format.dot.present)
-	ffelex_token_kill (ffestb_local_.format.dot.t);
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_EXP, t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100110_ -- [[+/-] NUMBER] NAMES NUMBER [PERIOD NUMBER ["E" NUMBER]]
-
-   return ffestb_R100110_;  // to lexer
-
-   Maybe find a NUMBER to append to the current number, in which case return
-   to this state.  Anything else, handle current descriptor, then pass token
-   on to state _10_.  */
-
-static ffelexHandler
-ffestb_R100110_ (ffelexToken t)
-{
-  ffeTokenLength i;
-  enum expect
-    {
-      required,
-      optional,
-      disallowed
-    };
-  ffebad err;
-  enum expect pre;
-  enum expect post;
-  enum expect dot;
-  enum expect exp;
-  bool R1005;
-  ffesttFormatList f;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      assert (ffestb_local_.format.exp.present);
-      ffesta_confirmed ();
-      if (ffestb_local_.format.exp.rtexpr)
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_NUMBER);
-	  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-	  ffebad_finish ();
-	  return (ffelexHandler) ffestb_R100110_;
-	}
-      for (i = ffelex_token_length (t) + 1; i > 0; --i)
-	ffestb_local_.format.exp.u.unsigned_val *= 10;
-      ffestb_local_.format.exp.u.unsigned_val += strtoul (ffelex_token_text (t),
-							  NULL, 10);
-      return (ffelexHandler) ffestb_R100110_;
-
-    default:
-      if (ffestb_local_.format.sign
-	  && (ffestb_local_.format.current != FFESTP_formattypeP)
-	  && (ffestb_local_.format.current != FFESTP_formattypeH))
-	{
-	  ffebad_start (FFEBAD_FORMAT_SPURIOUS_SIGN);
-	  ffebad_here (0, ffelex_token_where_line (ffestb_local_.format.pre.t),
-		    ffelex_token_where_column (ffestb_local_.format.pre.t));
-	  ffebad_finish ();
-	  ffestb_local_.format.pre.u.unsigned_val
-	    = (ffestb_local_.format.pre.u.signed_val < 0)
-	    ? -ffestb_local_.format.pre.u.signed_val
-	    : ffestb_local_.format.pre.u.signed_val;
-	}
-      switch (ffestb_local_.format.current)
-	{
-	case FFESTP_formattypeI:
-	  err = FFEBAD_FORMAT_BAD_I_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = optional;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeB:
-	  err = FFEBAD_FORMAT_BAD_B_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = optional;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeO:
-	  err = FFEBAD_FORMAT_BAD_O_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = optional;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeZ:
-	  err = FFEBAD_FORMAT_BAD_Z_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = optional;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeF:
-	  err = FFEBAD_FORMAT_BAD_F_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = required;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeE:
-	  err = FFEBAD_FORMAT_BAD_E_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = required;
-	  exp = optional;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeEN:
-	  err = FFEBAD_FORMAT_BAD_EN_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = required;
-	  exp = optional;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeG:
-	  err = FFEBAD_FORMAT_BAD_G_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = required;
-	  exp = optional;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeL:
-	  err = FFEBAD_FORMAT_BAD_L_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeA:
-	  err = FFEBAD_FORMAT_BAD_A_SPEC;
-	  pre = optional;
-	  post = optional;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeD:
-	  err = FFEBAD_FORMAT_BAD_D_SPEC;
-	  pre = optional;
-	  post = required;
-	  dot = required;
-	  exp = disallowed;
-	  R1005 = TRUE;
-	  break;
-
-	case FFESTP_formattypeQ:
-	  err = FFEBAD_FORMAT_BAD_Q_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeDOLLAR:
-	  err = FFEBAD_FORMAT_BAD_DOLLAR_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeP:
-	  err = FFEBAD_FORMAT_BAD_P_SPEC;
-	  pre = required;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeT:
-	  err = FFEBAD_FORMAT_BAD_T_SPEC;
-	  pre = disallowed;
-	  post = required;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeTL:
-	  err = FFEBAD_FORMAT_BAD_TL_SPEC;
-	  pre = disallowed;
-	  post = required;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeTR:
-	  err = FFEBAD_FORMAT_BAD_TR_SPEC;
-	  pre = disallowed;
-	  post = required;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeX:
-	  err = FFEBAD_FORMAT_BAD_X_SPEC;
-	  pre = ffe_is_pedantic() ? required : optional;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeS:
-	  err = FFEBAD_FORMAT_BAD_S_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeSP:
-	  err = FFEBAD_FORMAT_BAD_SP_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeSS:
-	  err = FFEBAD_FORMAT_BAD_SS_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeBN:
-	  err = FFEBAD_FORMAT_BAD_BN_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeBZ:
-	  err = FFEBAD_FORMAT_BAD_BZ_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeH:	/* Definitely an error, make sure of
-					   it. */
-	  err = FFEBAD_FORMAT_BAD_H_SPEC;
-	  pre = ffestb_local_.format.pre.present ? disallowed : required;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-
-	case FFESTP_formattypeNone:
-	  ffesta_ffebad_1t (FFEBAD_FORMAT_BAD_SPEC,
-			    ffestb_local_.format.t);
-
-	clean_up_to_11_:	/* :::::::::::::::::::: */
-
-	  ffelex_token_kill (ffestb_local_.format.t);
-	  if (ffestb_local_.format.pre.present)
-	    ffelex_token_kill (ffestb_local_.format.pre.t);
-	  if (ffestb_local_.format.post.present)
-	    ffelex_token_kill (ffestb_local_.format.post.t);
-	  if (ffestb_local_.format.dot.present)
-	    ffelex_token_kill (ffestb_local_.format.dot.t);
-	  if (ffestb_local_.format.exp.present)
-	    ffelex_token_kill (ffestb_local_.format.exp.t);
-	  return (ffelexHandler) ffestb_R100111_ (t);
-
-	default:
-	  assert ("bad format item" == NULL);
-	  err = FFEBAD_FORMAT_BAD_H_SPEC;
-	  pre = disallowed;
-	  post = disallowed;
-	  dot = disallowed;
-	  exp = disallowed;
-	  R1005 = FALSE;
-	  break;
-	}
-      if (((pre == disallowed) && ffestb_local_.format.pre.present)
-	  || ((pre == required) && !ffestb_local_.format.pre.present))
-	{
-	  ffesta_ffebad_1t (err, (pre == required)
-		     ? ffestb_local_.format.t : ffestb_local_.format.pre.t);
-	  goto clean_up_to_11_;	/* :::::::::::::::::::: */
-	}
-      if (((post == disallowed) && ffestb_local_.format.post.present)
-	  || ((post == required) && !ffestb_local_.format.post.present))
-	{
-	  ffesta_ffebad_1t (err, (post == required)
-		    ? ffestb_local_.format.t : ffestb_local_.format.post.t);
-	  goto clean_up_to_11_;	/* :::::::::::::::::::: */
-	}
-      if (((dot == disallowed) && ffestb_local_.format.dot.present)
-	  || ((dot == required) && !ffestb_local_.format.dot.present))
-	{
-	  ffesta_ffebad_1t (err, (dot == required)
-		     ? ffestb_local_.format.t : ffestb_local_.format.dot.t);
-	  goto clean_up_to_11_;	/* :::::::::::::::::::: */
-	}
-      if (((exp == disallowed) && ffestb_local_.format.exp.present)
-	  || ((exp == required) && !ffestb_local_.format.exp.present))
-	{
-	  ffesta_ffebad_1t (err, (exp == required)
-		     ? ffestb_local_.format.t : ffestb_local_.format.exp.t);
-	  goto clean_up_to_11_;	/* :::::::::::::::::::: */
-	}
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = ffestb_local_.format.current;
-      f->t = ffestb_local_.format.t;
-      if (R1005)
-	{
-	  f->u.R1005.R1004 = ffestb_local_.format.pre;
-	  f->u.R1005.R1006 = ffestb_local_.format.post;
-	  f->u.R1005.R1007_or_R1008 = ffestb_local_.format.dot;
-	  f->u.R1005.R1009 = ffestb_local_.format.exp;
-	}
-      else
-	/* Must be R1010. */
-	{
-	  if (pre == disallowed)
-	    f->u.R1010.val = ffestb_local_.format.post;
-	  else
-	    f->u.R1010.val = ffestb_local_.format.pre;
-	}
-      return (ffelexHandler) ffestb_R100111_ (t);
-    }
-}
-
-/* ffestb_R100111_ -- edit-descriptor
-
-   return ffestb_R100111_;  // to lexer
-
-   Expect a COMMA, CLOSE_PAREN, CLOSE_ARRAY, COLON, COLONCOLON, SLASH, or
-   CONCAT, or complain about missing comma.  */
-
-static ffelexHandler
-ffestb_R100111_ (ffelexToken t)
-{
-  ffesttFormatList f;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R10012_;
-
-    case FFELEX_typeCOLON:
-    case FFELEX_typeCOLONCOLON:
-    case FFELEX_typeSLASH:
-    case FFELEX_typeCONCAT:
-      return (ffelexHandler) ffestb_R10012_ (t);
-
-    case FFELEX_typeCLOSE_PAREN:
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeCLOSE_ARRAY:	/* "/)". */
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeOPEN_ANGLE:
-    case FFELEX_typeDOLLAR:
-    case FFELEX_typeNUMBER:
-    case FFELEX_typeOPEN_PAREN:
-    case FFELEX_typeOPEN_ARRAY:
-    case FFELEX_typeQUOTE:
-    case FFELEX_typeAPOSTROPHE:
-    case FFELEX_typeNAMES:
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_COMMA, t);
-      return (ffelexHandler) ffestb_R10012_ (t);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
-      for (f = ffestb_local_.format.f;
-	   f->u.root.parent != NULL;
-	   f = f->u.root.parent->next)
-	;
-      ffestb_local_.format.f = f;
-      return (ffelexHandler) ffestb_R100114_ (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100112_ -- COLON, COLONCOLON, SLASH, OPEN_ARRAY, or CONCAT
-
-   return ffestb_R100112_;  // to lexer
-
-   Like _11_ except the COMMA is optional.  */
-
-static ffelexHandler
-ffestb_R100112_ (ffelexToken t)
-{
-  ffesttFormatList f;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R10012_;
-
-    case FFELEX_typeCOLON:
-    case FFELEX_typeCOLONCOLON:
-    case FFELEX_typeSLASH:
-    case FFELEX_typeCONCAT:
-    case FFELEX_typeOPEN_ANGLE:
-    case FFELEX_typeNAMES:
-    case FFELEX_typeDOLLAR:
-    case FFELEX_typeNUMBER:
-    case FFELEX_typeOPEN_PAREN:
-    case FFELEX_typeOPEN_ARRAY:
-    case FFELEX_typeQUOTE:
-    case FFELEX_typeAPOSTROPHE:
-    case FFELEX_typePLUS:
-    case FFELEX_typeMINUS:
-      return (ffelexHandler) ffestb_R10012_ (t);
-
-    case FFELEX_typeCLOSE_PAREN:
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeCLOSE_ARRAY:	/* "/)". */
-      f = ffestt_formatlist_append (ffestb_local_.format.f);
-      f->type = FFESTP_formattypeSLASH;
-      f->t = ffelex_token_use (t);
-      f->u.R1010.val.present = FALSE;
-      f->u.R1010.val.rtexpr = FALSE;
-      f->u.R1010.val.t = NULL;
-      f->u.R1010.val.u.unsigned_val = 1;
-      f = ffestb_local_.format.f->u.root.parent;
-      if (f == NULL)
-	return (ffelexHandler) ffestb_R100114_;
-      ffestb_local_.format.f = f->next;
-      return (ffelexHandler) ffestb_R100111_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      ffesta_ffebad_1t (FFEBAD_FORMAT_MISSING_PAREN, t);
-      for (f = ffestb_local_.format.f;
-	   f->u.root.parent != NULL;
-	   f = f->u.root.parent->next)
-	;
-      ffestb_local_.format.f = f;
-      return (ffelexHandler) ffestb_R100114_ (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100113_ -- Handle CHARACTER token.
-
-   return ffestb_R100113_;  // to lexer
-
-   Append the format item to the list, go to _11_.  */
-
-static ffelexHandler
-ffestb_R100113_ (ffelexToken t)
-{
-  ffesttFormatList f;
-
-  assert (ffelex_token_type (t) == FFELEX_typeCHARACTER);
-
-  if (ffe_is_pedantic_not_90 () && (ffelex_token_length (t) == 0))
-    {
-      ffebad_start (FFEBAD_NULL_CHAR_CONST);
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_finish ();
-    }
-
-  f = ffestt_formatlist_append (ffestb_local_.format.f);
-  f->type = FFESTP_formattypeR1016;
-  f->t = ffelex_token_use (t);
-  return (ffelexHandler) ffestb_R100111_;
-}
-
-/* ffestb_R100114_ -- "FORMAT" OPEN_PAREN format-item-list CLOSE_PAREN
-
-   return ffestb_R100114_;  // to lexer
-
-   Handle EOS/SEMICOLON or something else.  */
-
-static ffelexHandler
-ffestb_R100114_ (ffelexToken t)
-{
-  ffelex_set_names_pure (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited () && !ffestb_local_.format.complained)
-	ffestc_R1001 (ffestb_local_.format.f);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100115_ -- OPEN_ANGLE expr
-
-   (ffestb_R100115_)  // to expression handler
-
-   Handle expression prior to the edit descriptor.  */
-
-static ffelexHandler
-ffestb_R100115_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_ANGLE:
-      ffestb_local_.format.pre.present = TRUE;
-      ffestb_local_.format.pre.rtexpr = TRUE;
-      ffestb_local_.format.pre.u.expr = expr;
-      ffelex_set_names_pure (TRUE);
-      return (ffelexHandler) ffestb_R10014_;
-
-    default:
-      ffelex_token_kill (ffestb_local_.format.pre.t);
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100116_ -- "[n]X" OPEN_ANGLE expr
-
-   (ffestb_R100116_)  // to expression handler
-
-   Handle expression after the edit descriptor.	 */
-
-static ffelexHandler
-ffestb_R100116_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_ANGLE:
-      ffestb_local_.format.post.present = TRUE;
-      ffestb_local_.format.post.rtexpr = TRUE;
-      ffestb_local_.format.post.u.expr = expr;
-      ffelex_set_names_pure (TRUE);
-      return (ffelexHandler) ffestb_R10016_;
-
-    default:
-      ffelex_token_kill (ffestb_local_.format.t);
-      ffelex_token_kill (ffestb_local_.format.post.t);
-      if (ffestb_local_.format.pre.present)
-	ffelex_token_kill (ffestb_local_.format.pre.t);
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100117_ -- "[n]X[n]." OPEN_ANGLE expr
-
-   (ffestb_R100117_)  // to expression handler
-
-   Handle expression after the PERIOD.	*/
-
-static ffelexHandler
-ffestb_R100117_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_ANGLE:
-      ffestb_local_.format.dot.present = TRUE;
-      ffestb_local_.format.dot.rtexpr = TRUE;
-      ffestb_local_.format.dot.u.expr = expr;
-      ffelex_set_names_pure (TRUE);
-      return (ffelexHandler) ffestb_R10018_;
-
-    default:
-      ffelex_token_kill (ffestb_local_.format.t);
-      ffelex_token_kill (ffestb_local_.format.dot.t);
-      if (ffestb_local_.format.pre.present)
-	ffelex_token_kill (ffestb_local_.format.pre.t);
-      if (ffestb_local_.format.post.present)
-	ffelex_token_kill (ffestb_local_.format.post.t);
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_R100118_ -- "[n]X[n].[n]E" OPEN_ANGLE expr
-
-   (ffestb_R100118_)  // to expression handler
-
-   Handle expression after the "E".  */
-
-static ffelexHandler
-ffestb_R100118_ (ffelexToken ft UNUSED, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_ANGLE:
-      ffestb_local_.format.exp.present = TRUE;
-      ffestb_local_.format.exp.rtexpr = TRUE;
-      ffestb_local_.format.exp.u.expr = expr;
-      ffelex_set_names_pure (TRUE);
-      return (ffelexHandler) ffestb_R100110_;
-
-    default:
-      ffelex_token_kill (ffestb_local_.format.t);
-      ffelex_token_kill (ffestb_local_.format.exp.t);
-      if (ffestb_local_.format.pre.present)
-	ffelex_token_kill (ffestb_local_.format.pre.t);
-      if (ffestb_local_.format.post.present)
-	ffelex_token_kill (ffestb_local_.format.post.t);
-      if (ffestb_local_.format.dot.present)
-	ffelex_token_kill (ffestb_local_.format.dot.t);
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FORMAT", t);
-      ffestt_formatlist_kill (ffestb_local_.format.f);
-      return (ffelexHandler) ffelex_swallow_tokens (t,
-					       (ffelexHandler) ffesta_zero);
-    }
-}
-
-/* ffestb_S3P4 -- Parse the INCLUDE line
-
-   return ffestb_S3P4;	// to lexer
-
-   Make sure the statement has a valid form for the INCLUDE line.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_S3P4 (ffelexToken t)
-{
-  ffeTokenLength i;
-  const char *p;
-  ffelexHandler next;
-  ffelexToken nt;
-  ffelexToken ut;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstINCLUDE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeNUMBER:
-	case FFELEX_typeAPOSTROPHE:
-	case FFELEX_typeQUOTE:
-	  break;
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-      ffesta_confirmed ();
-      return (ffelexHandler) (*((ffelexHandler)
-		    ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
-				 (ffeexprCallback) ffestb_S3P41_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstINCLUDE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlINCLUDE);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeAPOSTROPHE:
-	case FFELEX_typeQUOTE:
-	  break;
-	}
-      ffesta_confirmed ();
-      if (*p == '\0')
-	return (ffelexHandler) (*((ffelexHandler)
-		    ffeexpr_rhs (ffesta_output_pool, FFEEXPR_contextINCLUDE,
-				 (ffeexprCallback) ffestb_S3P41_)))
-	  (t);
-      if (! ISDIGIT (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      nt = ffelex_token_number_from_names (ffesta_tokens[0], i);
-      p += ffelex_token_length (nt);
-      i += ffelex_token_length (nt);
-      if ((*p != '_') || (++i, *++p != '\0'))
-	{
-	  ffelex_token_kill (nt);
-	  goto bad_i;		/* :::::::::::::::::::: */
-	}
-      ut = ffelex_token_uscore_from_names (ffesta_tokens[0], i - 1);
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs
-				(ffesta_output_pool, FFEEXPR_contextINCLUDE,
-				 (ffeexprCallback) ffestb_S3P41_)))
-	(nt);
-      ffelex_token_kill (nt);
-      next = (ffelexHandler) (*next) (ut);
-      ffelex_token_kill (ut);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "INCLUDE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_S3P41_ -- "INCLUDE" [NUMBER "_"] expr
-
-   (ffestb_S3P41_)  // to expression handler
-
-   Make sure the next token is an EOS, but not a SEMICOLON.  */
-
-static ffelexHandler
-ffestb_S3P41_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffe_is_pedantic ()
-	      && ((ffelex_token_type (t) == FFELEX_typeSEMICOLON)
-		  || ffesta_line_has_semicolons))
-	    {
-	      /* xgettext:no-c-format */
-	      ffebad_start_msg ("INCLUDE at %0 not the only statement on the source line", FFEBAD_severityWARNING);
-	      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-			   ffelex_token_where_column (ffesta_tokens[0]));
-	      ffebad_finish ();
-	    }
-	  ffestc_S3P4 (expr, ft);
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INCLUDE", t);
-      break;
-    }
-
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V014 -- Parse the VOLATILE statement
-
-   return ffestb_V014;	// to lexer
-
-   Make sure the statement has a valid form for the VOLATILE statement.	 If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_V014 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstVOLATILE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeNAME:
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_V014_start ();
-	  return (ffelexHandler) ffestb_V0141_ (t);
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_V014_start ();
-	  return (ffelexHandler) ffestb_V0141_;
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstVOLATILE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlVOLATILE);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_V014_start ();
-	  return (ffelexHandler) ffestb_V0141_ (t);
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_V014_start ();
-	  return (ffelexHandler) ffestb_V0141_;
-	}
-
-      /* Here, we have at least one char after "VOLATILE" and t is COMMA or
-	 EOS/SEMICOLON. */
-
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      if (!ffesta_is_inhibited ())
-	ffestc_V014_start ();
-      next = (ffelexHandler) ffestb_V0141_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "VOLATILE", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0141_ -- "VOLATILE" [COLONCOLON]
-
-   return ffestb_V0141_;  // to lexer
-
-   Handle NAME or SLASH.  */
-
-static ffelexHandler
-ffestb_V0141_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffestb_local_.V014.is_cblock = FALSE;
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_V0144_;
-
-    case FFELEX_typeSLASH:
-      ffestb_local_.V014.is_cblock = TRUE;
-      return (ffelexHandler) ffestb_V0142_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_V014_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0142_ -- "VOLATILE" [COLONCOLON] SLASH
-
-   return ffestb_V0142_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_V0142_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_V0143_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_V014_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0143_ -- "VOLATILE" [COLONCOLON] SLASH NAME
-
-   return ffestb_V0143_;  // to lexer
-
-   Handle SLASH.  */
-
-static ffelexHandler
-ffestb_V0143_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_V0144_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_V014_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0144_ -- "VOLATILE" [COLONCOLON] R523
-
-   return ffestb_V0144_;  // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_V0144_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffestb_local_.V014.is_cblock)
-	    ffestc_V014_item_cblock (ffesta_tokens[1]);
-	  else
-	    ffestc_V014_item_object (ffesta_tokens[1]);
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_V0141_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  if (ffestb_local_.V014.is_cblock)
-	    ffestc_V014_item_cblock (ffesta_tokens[1]);
-	  else
-	    ffestc_V014_item_object (ffesta_tokens[1]);
-	  ffestc_V014_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "VOLATILE", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_V014_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_subr_kill_easy_ -- Kill I/O statement data structure
-
-   ffestb_subr_kill_easy_();
-
-   Kills all tokens in the I/O data structure.	Assumes that they are
-   overlaid with each other (union) in ffest_private.h and the typing
-   and structure references assume (though not necessarily dangerous if
-   FALSE) that INQUIRE has the most file elements.  */
-
-#if FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_easy_ (ffestpInquireIx max)
-{
-  ffestpInquireIx ix;
-
-  for (ix = 0; ix < max; ++ix)
-    {
-      if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.inquire.inquire_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
-	  if (ffestp_file.inquire.inquire_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_accept_ -- Kill ACCEPT statement data structure
-
-   ffestb_subr_kill_accept_();
-
-   Kills all tokens in the ACCEPT data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_accept_ (void)
-{
-  ffestpAcceptIx ix;
-
-  for (ix = 0; ix < FFESTP_acceptix; ++ix)
-    {
-      if (ffestp_file.accept.accept_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.accept.accept_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.accept.accept_spec[ix].kw);
-	  if (ffestp_file.accept.accept_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.accept.accept_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_beru_ -- Kill BACKSPACE/ENDFILE/REWIND/UNLOCK statement
-			    data structure
-
-   ffestb_subr_kill_beru_();
-
-   Kills all tokens in the BACKSPACE/ENDFILE/REWIND/UNLOCK data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_beru_ (void)
-{
-  ffestpBeruIx ix;
-
-  for (ix = 0; ix < FFESTP_beruix; ++ix)
-    {
-      if (ffestp_file.beru.beru_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.beru.beru_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.beru.beru_spec[ix].kw);
-	  if (ffestp_file.beru.beru_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.beru.beru_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_close_ -- Kill CLOSE statement data structure
-
-   ffestb_subr_kill_close_();
-
-   Kills all tokens in the CLOSE data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_close_ (void)
-{
-  ffestpCloseIx ix;
-
-  for (ix = 0; ix < FFESTP_closeix; ++ix)
-    {
-      if (ffestp_file.close.close_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.close.close_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.close.close_spec[ix].kw);
-	  if (ffestp_file.close.close_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.close.close_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_delete_ -- Kill DELETE statement data structure
-
-   ffestb_subr_kill_delete_();
-
-   Kills all tokens in the DELETE data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_delete_ (void)
-{
-  ffestpDeleteIx ix;
-
-  for (ix = 0; ix < FFESTP_deleteix; ++ix)
-    {
-      if (ffestp_file.delete.delete_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.delete.delete_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.delete.delete_spec[ix].kw);
-	  if (ffestp_file.delete.delete_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.delete.delete_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_inquire_ -- Kill INQUIRE statement data structure
-
-   ffestb_subr_kill_inquire_();
-
-   Kills all tokens in the INQUIRE data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_inquire_ (void)
-{
-  ffestpInquireIx ix;
-
-  for (ix = 0; ix < FFESTP_inquireix; ++ix)
-    {
-      if (ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.inquire.inquire_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].kw);
-	  if (ffestp_file.inquire.inquire_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.inquire.inquire_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_open_ -- Kill OPEN statement data structure
-
-   ffestb_subr_kill_open_();
-
-   Kills all tokens in the OPEN data structure.	 */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_open_ (void)
-{
-  ffestpOpenIx ix;
-
-  for (ix = 0; ix < FFESTP_openix; ++ix)
-    {
-      if (ffestp_file.open.open_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.open.open_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.open.open_spec[ix].kw);
-	  if (ffestp_file.open.open_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.open.open_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_print_ -- Kill PRINT statement data structure
-
-   ffestb_subr_kill_print_();
-
-   Kills all tokens in the PRINT data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_print_ (void)
-{
-  ffestpPrintIx ix;
-
-  for (ix = 0; ix < FFESTP_printix; ++ix)
-    {
-      if (ffestp_file.print.print_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.print.print_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.print.print_spec[ix].kw);
-	  if (ffestp_file.print.print_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.print.print_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_read_ -- Kill READ statement data structure
-
-   ffestb_subr_kill_read_();
-
-   Kills all tokens in the READ data structure.	 */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_read_ (void)
-{
-  ffestpReadIx ix;
-
-  for (ix = 0; ix < FFESTP_readix; ++ix)
-    {
-      if (ffestp_file.read.read_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.read.read_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.read.read_spec[ix].kw);
-	  if (ffestp_file.read.read_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.read.read_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_rewrite_ -- Kill REWRITE statement data structure
-
-   ffestb_subr_kill_rewrite_();
-
-   Kills all tokens in the REWRITE data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_rewrite_ (void)
-{
-  ffestpRewriteIx ix;
-
-  for (ix = 0; ix < FFESTP_rewriteix; ++ix)
-    {
-      if (ffestp_file.rewrite.rewrite_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.rewrite.rewrite_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].kw);
-	  if (ffestp_file.rewrite.rewrite_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.rewrite.rewrite_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_type_ -- Kill TYPE statement data structure
-
-   ffestb_subr_kill_type_();
-
-   Kills all tokens in the TYPE data structure.	 */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_type_ (void)
-{
-  ffestpTypeIx ix;
-
-  for (ix = 0; ix < FFESTP_typeix; ++ix)
-    {
-      if (ffestp_file.type.type_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.type.type_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.type.type_spec[ix].kw);
-	  if (ffestp_file.type.type_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.type.type_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_subr_kill_write_ -- Kill WRITE statement data structure
-
-   ffestb_subr_kill_write_();
-
-   Kills all tokens in the WRITE data structure.  */
-
-#if !FFESTB_KILL_EASY_
-static void
-ffestb_subr_kill_write_ (void)
-{
-  ffestpWriteIx ix;
-
-  for (ix = 0; ix < FFESTP_writeix; ++ix)
-    {
-      if (ffestp_file.write.write_spec[ix].kw_or_val_present)
-	{
-	  if (ffestp_file.write.write_spec[ix].kw_present)
-	    ffelex_token_kill (ffestp_file.write.write_spec[ix].kw);
-	  if (ffestp_file.write.write_spec[ix].value_present)
-	    ffelex_token_kill (ffestp_file.write.write_spec[ix].value);
-	}
-    }
-}
-
-#endif
-/* ffestb_beru -- Parse the BACKSPACE/ENDFILE/REWIND/UNLOCK statement
-
-   return ffestb_beru;	// to lexer
-
-   Make sure the statement has a valid form for the BACKSPACE/ENDFILE/REWIND/
-   UNLOCK statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_beru (ffelexToken t)
-{
-  ffelexHandler next;
-  ffestpBeruIx 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:
-	  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;
-
-	case FFELEX_typeOPEN_PAREN:
-	  for (ix = 0; ix < FFESTP_beruix; ++ix)
-	    ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_beru2_;
-
-	default:
-	  break;
-	}
-
-      for (ix = 0; ix < FFESTP_beruix; ++ix)
-	ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-					     FFEEXPR_contextFILENUM,
-					  (ffeexprCallback) ffestb_beru1_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEQUALS:
-	case FFELEX_typePOINTS:
-	case FFELEX_typeCOLON:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (ffelex_token_length (ffesta_tokens[0])
-	      != ffestb_args.beru.len)
-	    break;
-
-	  for (ix = 0; ix < FFESTP_beruix; ++ix)
-	    ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_beru2_;
-
-	default:
-	  break;
-	}
-      for (ix = 0; ix < FFESTP_beruix; ++ix)
-	ffestp_file.beru.beru_spec[ix].kw_or_val_present = FALSE;
-      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		   FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_beru1_);
-      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
-						   ffestb_args.beru.len);
-      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, ffestb_args.beru.badname, ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_beru1_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" expr
-
-   (ffestb_beru1_)  // to expression handler
-
-   Make sure the next token is an EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_beru1_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      ffesta_confirmed ();
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
-      if (!ffesta_is_inhibited ())
-	{
-	  switch (ffesta_first_kw)
-	    {
-	    case FFESTR_firstBACKSPACE:
-	      ffestc_R919 ();
-	      break;
-
-	    case FFESTR_firstENDFILE:
-	    case FFESTR_firstEND:
-	      ffestc_R920 ();
-	      break;
-
-	    case FFESTR_firstREWIND:
-	      ffestc_R921 ();
-	      break;
-
-	    default:
-	      assert (FALSE);
-	    }
-	}
-      ffestb_subr_kill_beru_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru2_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN
-
-   return ffestb_beru2_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_beru2_ (ffelexToken t)
-{
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_beru3_;
-
-    default:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	     FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_beru3_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN NAME
-
-   return ffestb_beru3_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_beru3_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-  ffelexToken ot;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffelex_token_kill (ffesta_tokens[1]);
-      nt = ffesta_tokens[2];
-      next = (ffelexHandler) ffestb_beru5_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      nt = ffesta_tokens[1];
-      ot = ffesta_tokens[2];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	     FFEEXPR_contextFILENUMAMBIG, (ffeexprCallback) ffestb_beru4_)))
-	(nt);
-      ffelex_token_kill (nt);
-      next = (ffelexHandler) (*next) (ot);
-      ffelex_token_kill (ot);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_beru4_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN expr [CLOSE_PAREN]
-
-   (ffestb_beru4_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.
-
-   15-Feb-91  JCB  1.2
-      Now using new mechanism whereby expr comes back as opITEM if the
-      expr is considered part (or all) of an I/O control list (and should
-      be stripped of its outer opITEM node) or not if it is considered
-      a plain unit number that happens to have been enclosed in parens.
-   26-Mar-90  JCB  1.1
-      No longer expecting close-paren here because of constructs like
-      BACKSPACE (5)+2, so now expecting either COMMA because it was a
-      construct like BACKSPACE (5+2,... or EOS/SEMICOLON because it is like
-      the former construct.  Ah, the vagaries of Fortran.  */
-
-static ffelexHandler
-ffestb_beru4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  bool inlist;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      if (ffebld_op (expr) == FFEBLD_opITEM)
-	{
-	  inlist = TRUE;
-	  expr = ffebld_head (expr);
-	}
-      else
-	inlist = FALSE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].kw_present = FALSE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_present = TRUE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.beru.beru_spec[FFESTP_beruixUNIT].u.expr = expr;
-      if (inlist)
-	return (ffelexHandler) ffestb_beru9_ (t);
-      return (ffelexHandler) ffestb_beru10_ (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru5_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
-		    COMMA]
-
-   return ffestb_beru5_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_beru5_ (ffelexToken t)
-{
-  ffestrGenio kw;
-
-  ffestb_local_.beru.label = FALSE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      kw = ffestr_genio (t);
-      switch (kw)
-	{
-	case FFESTR_genioERR:
-	  ffestb_local_.beru.ix = FFESTP_beruixERR;
-	  ffestb_local_.beru.label = TRUE;
-	  break;
-
-	case FFESTR_genioIOSTAT:
-	  ffestb_local_.beru.ix = FFESTP_beruixIOSTAT;
-	  ffestb_local_.beru.left = TRUE;
-	  ffestb_local_.beru.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_genioUNIT:
-	  ffestb_local_.beru.ix = FFESTP_beruixUNIT;
-	  ffestb_local_.beru.left = FALSE;
-	  ffestb_local_.beru.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
-	  .kw_or_val_present)
-	break;			/* Can't specify a keyword twice! */
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
-	.kw_or_val_present = TRUE;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
-	.kw_present = TRUE;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix]
-	.value_present = FALSE;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_is_label
-	= ffestb_local_.beru.label;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].kw
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_beru6_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru6_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN [external-file-unit
-		    COMMA] NAME
-
-   return ffestb_beru6_;  // to lexer
-
-   Make sure EQUALS here, send next token to expression handler.  */
-
-static ffelexHandler
-ffestb_beru6_ (ffelexToken t)
-{
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestb_local_.beru.label)
-	return (ffelexHandler) ffestb_beru8_;
-      if (ffestb_local_.beru.left)
-	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					    ffestb_local_.beru.context,
-					    (ffeexprCallback) ffestb_beru7_);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_local_.beru.context,
-					  (ffeexprCallback) ffestb_beru7_);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru7_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS expr
-
-   (ffestb_beru7_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_beru7_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
-	= TRUE;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
-	= ffelex_token_use (ft);
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_beru5_;
-      return (ffelexHandler) ffestb_beru10_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru8_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
-
-   return ffestb_beru8_;  // to lexer
-
-   Handle NUMBER for label here.  */
-
-static ffelexHandler
-ffestb_beru8_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value_present
-	= TRUE;
-      ffestp_file.beru.beru_spec[ffestb_local_.beru.ix].value
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_beru9_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru9_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... NAME EQUALS
-		   NUMBER
-
-   return ffestb_beru9_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_beru9_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_beru5_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_beru10_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_beru10_ -- "BACKSPACE/ENDFILE/REWIND/UNLOCK" OPEN_PAREN ... CLOSE_PAREN
-
-   return ffestb_beru10_;  // to lexer
-
-   Handle EOS or SEMICOLON here.  */
-
-static ffelexHandler
-ffestb_beru10_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  switch (ffesta_first_kw)
-	    {
-	    case FFESTR_firstBACKSPACE:
-	      ffestc_R919 ();
-	      break;
-
-	    case FFESTR_firstENDFILE:
-	    case FFESTR_firstEND:
-	      ffestc_R920 ();
-	      break;
-
-	    case FFESTR_firstREWIND:
-	      ffestc_R921 ();
-	      break;
-
-	    default:
-	      assert (FALSE);
-	    }
-	}
-      ffestb_subr_kill_beru_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_beru_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.beru.badname, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R904 -- Parse an OPEN statement
-
-   return ffestb_R904;	// to lexer
-
-   Make sure the statement has a valid form for an OPEN statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R904 (ffelexToken t)
-{
-  ffestpOpenIx ix;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstOPEN)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstOPEN)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlOPEN)
-	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_openix; ++ix)
-    ffestp_file.open.open_spec[ix].kw_or_val_present = FALSE;
-
-  return (ffelexHandler) ffestb_R9041_;
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R9041_ -- "OPEN" OPEN_PAREN
-
-   return ffestb_R9041_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9041_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9042_;
-
-    default:
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
-	(t);
-    }
-}
-
-/* ffestb_R9042_ -- "OPEN" OPEN_PAREN NAME
-
-   return ffestb_R9042_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9042_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) ffestb_R9044_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9043_)))
-	(ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9043_ -- "OPEN" OPEN_PAREN expr
-
-   (ffestb_R9043_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9043_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.open.open_spec[FFESTP_openixUNIT].kw_present = FALSE;
-      ffestp_file.open.open_spec[FFESTP_openixUNIT].value_present = TRUE;
-      ffestp_file.open.open_spec[FFESTP_openixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.open.open_spec[FFESTP_openixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.open.open_spec[FFESTP_openixUNIT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9044_;
-      return (ffelexHandler) ffestb_R9049_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9044_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA]
-
-   return ffestb_R9044_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9044_ (ffelexToken t)
-{
-  ffestrOpen kw;
-
-  ffestb_local_.open.label = FALSE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      kw = ffestr_open (t);
-      switch (kw)
-	{
-	case FFESTR_openACCESS:
-	  ffestb_local_.open.ix = FFESTP_openixACCESS;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openACTION:
-	  ffestb_local_.open.ix = FFESTP_openixACTION;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openASSOCIATEVARIABLE:
-	  ffestb_local_.open.ix = FFESTP_openixASSOCIATEVARIABLE;
-	  ffestb_local_.open.left = TRUE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEASSOC;
-	  break;
-
-	case FFESTR_openBLANK:
-	  ffestb_local_.open.ix = FFESTP_openixBLANK;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openBLOCKSIZE:
-	  ffestb_local_.open.ix = FFESTP_openixBLOCKSIZE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openBUFFERCOUNT:
-	  ffestb_local_.open.ix = FFESTP_openixBUFFERCOUNT;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openCARRIAGECONTROL:
-	  ffestb_local_.open.ix = FFESTP_openixCARRIAGECONTROL;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_openDEFAULTFILE:
-	  ffestb_local_.open.ix = FFESTP_openixDEFAULTFILE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_openDELIM:
-	  ffestb_local_.open.ix = FFESTP_openixDELIM;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openDISP:
-	case FFESTR_openDISPOSE:
-	  ffestb_local_.open.ix = FFESTP_openixDISPOSE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_openERR:
-	  ffestb_local_.open.ix = FFESTP_openixERR;
-	  ffestb_local_.open.label = TRUE;
-	  break;
-
-	case FFESTR_openEXTENDSIZE:
-	  ffestb_local_.open.ix = FFESTP_openixEXTENDSIZE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openFILE:
-	case FFESTR_openNAME:
-	  ffestb_local_.open.ix = FFESTP_openixFILE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_openFORM:
-	  ffestb_local_.open.ix = FFESTP_openixFORM;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openINITIALSIZE:
-	  ffestb_local_.open.ix = FFESTP_openixINITIALSIZE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openIOSTAT:
-	  ffestb_local_.open.ix = FFESTP_openixIOSTAT;
-	  ffestb_local_.open.left = TRUE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEINT;
-	  break;
-
-#if 0				/* Haven't added support for expression
-				   context yet (though easy). */
-	case FFESTR_openKEY:
-	  ffestb_local_.open.ix = FFESTP_openixKEY;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEKEY;
-	  break;
-#endif
-
-	case FFESTR_openMAXREC:
-	  ffestb_local_.open.ix = FFESTP_openixMAXREC;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openNOSPANBLOCKS:
-	  if (ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
-	      .kw_or_val_present)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
-	    .kw_or_val_present = TRUE;
-	  ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
-	    .kw_present = TRUE;
-	  ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS]
-	    .value_present = FALSE;
-	  ffestp_file.open.open_spec[FFESTP_openixNOSPANBLOCKS].kw
-	    = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R9048_;
-
-	case FFESTR_openORGANIZATION:
-	  ffestb_local_.open.ix = FFESTP_openixORGANIZATION;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_openPAD:
-	  ffestb_local_.open.ix = FFESTP_openixPAD;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openPOSITION:
-	  ffestb_local_.open.ix = FFESTP_openixPOSITION;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openREADONLY:
-	  if (ffestp_file.open.open_spec[FFESTP_openixREADONLY]
-	      .kw_or_val_present)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestp_file.open.open_spec[FFESTP_openixREADONLY]
-	    .kw_or_val_present = TRUE;
-	  ffestp_file.open.open_spec[FFESTP_openixREADONLY]
-	    .kw_present = TRUE;
-	  ffestp_file.open.open_spec[FFESTP_openixREADONLY]
-	    .value_present = FALSE;
-	  ffestp_file.open.open_spec[FFESTP_openixREADONLY].kw
-	    = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R9048_;
-
-	case FFESTR_openRECL:
-	case FFESTR_openRECORDSIZE:
-	  ffestb_local_.open.ix = FFESTP_openixRECL;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openRECORDTYPE:
-	  ffestb_local_.open.ix = FFESTP_openixRECORDTYPE;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_openSHARED:
-	  if (ffestp_file.open.open_spec[FFESTP_openixSHARED]
-	      .kw_or_val_present)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestp_file.open.open_spec[FFESTP_openixSHARED]
-	    .kw_or_val_present = TRUE;
-	  ffestp_file.open.open_spec[FFESTP_openixSHARED]
-	    .kw_present = TRUE;
-	  ffestp_file.open.open_spec[FFESTP_openixSHARED]
-	    .value_present = FALSE;
-	  ffestp_file.open.open_spec[FFESTP_openixSHARED].kw
-	    = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R9048_;
-
-	case FFESTR_openSTATUS:
-	case FFESTR_openTYPE:
-	  ffestb_local_.open.ix = FFESTP_openixSTATUS;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_openUNIT:
-	  ffestb_local_.open.ix = FFESTP_openixUNIT;
-	  ffestb_local_.open.left = FALSE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_openUSEROPEN:
-	  ffestb_local_.open.ix = FFESTP_openixUSEROPEN;
-	  ffestb_local_.open.left = TRUE;
-	  ffestb_local_.open.context = FFEEXPR_contextFILEEXTFUNC;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.open.open_spec[ffestb_local_.open.ix]
-	  .kw_or_val_present)
-	break;			/* Can't specify a keyword twice! */
-      ffestp_file.open.open_spec[ffestb_local_.open.ix]
-	.kw_or_val_present = TRUE;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix]
-	.kw_present = TRUE;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix]
-	.value_present = FALSE;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].value_is_label
-	= ffestb_local_.open.label;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].kw
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9045_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9045_ -- "OPEN" OPEN_PAREN [external-file-unit COMMA] NAME
-
-   return ffestb_R9045_;  // to lexer
-
-   Make sure EQUALS here, send next token to expression handler.  */
-
-static ffelexHandler
-ffestb_R9045_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestb_local_.open.label)
-	return (ffelexHandler) ffestb_R9047_;
-      if (ffestb_local_.open.left)
-	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					    ffestb_local_.open.context,
-					    (ffeexprCallback) ffestb_R9046_);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_local_.open.context,
-					  (ffeexprCallback) ffestb_R9046_);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9046_ -- "OPEN" OPEN_PAREN ... NAME EQUALS expr
-
-   (ffestb_R9046_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9046_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
-	= TRUE;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].value
-	= ffelex_token_use (ft);
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9044_;
-      return (ffelexHandler) ffestb_R9049_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9047_ -- "OPEN" OPEN_PAREN ... NAME EQUALS
-
-   return ffestb_R9047_;  // to lexer
-
-   Handle NUMBER for label here.  */
-
-static ffelexHandler
-ffestb_R9047_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].value_present
-	= TRUE;
-      ffestp_file.open.open_spec[ffestb_local_.open.ix].value
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9048_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9048_ -- "OPEN" OPEN_PAREN ... NAME EQUALS NUMBER
-
-   return ffestb_R9048_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9048_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R9044_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_R9049_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9049_ -- "OPEN" OPEN_PAREN ... CLOSE_PAREN
-
-   return ffestb_R9049_;  // to lexer
-
-   Handle EOS or SEMICOLON here.  */
-
-static ffelexHandler
-ffestb_R9049_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R904 ();
-      ffestb_subr_kill_open_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_open_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "OPEN", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R907 -- Parse a CLOSE statement
-
-   return ffestb_R907;	// to lexer
-
-   Make sure the statement has a valid form for a CLOSE statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R907 (ffelexToken t)
-{
-  ffestpCloseIx ix;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCLOSE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstCLOSE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlCLOSE)
-	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_closeix; ++ix)
-    ffestp_file.close.close_spec[ix].kw_or_val_present = FALSE;
-
-  return (ffelexHandler) ffestb_R9071_;
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R9071_ -- "CLOSE" OPEN_PAREN
-
-   return ffestb_R9071_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9071_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9072_;
-
-    default:
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
-	(t);
-    }
-}
-
-/* ffestb_R9072_ -- "CLOSE" OPEN_PAREN NAME
-
-   return ffestb_R9072_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9072_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) ffestb_R9074_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9073_)))
-	(ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9073_ -- "CLOSE" OPEN_PAREN expr
-
-   (ffestb_R9073_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9073_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.close.close_spec[FFESTP_closeixUNIT].kw_present = FALSE;
-      ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_present = TRUE;
-      ffestp_file.close.close_spec[FFESTP_closeixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.close.close_spec[FFESTP_closeixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.close.close_spec[FFESTP_closeixUNIT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9074_;
-      return (ffelexHandler) ffestb_R9079_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9074_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA]
-
-   return ffestb_R9074_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9074_ (ffelexToken t)
-{
-  ffestrGenio kw;
-
-  ffestb_local_.close.label = FALSE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      kw = ffestr_genio (t);
-      switch (kw)
-	{
-	case FFESTR_genioERR:
-	  ffestb_local_.close.ix = FFESTP_closeixERR;
-	  ffestb_local_.close.label = TRUE;
-	  break;
-
-	case FFESTR_genioIOSTAT:
-	  ffestb_local_.close.ix = FFESTP_closeixIOSTAT;
-	  ffestb_local_.close.left = TRUE;
-	  ffestb_local_.close.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_genioSTATUS:
-	case FFESTR_genioDISP:
-	case FFESTR_genioDISPOSE:
-	  ffestb_local_.close.ix = FFESTP_closeixSTATUS;
-	  ffestb_local_.close.left = FALSE;
-	  ffestb_local_.close.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_genioUNIT:
-	  ffestb_local_.close.ix = FFESTP_closeixUNIT;
-	  ffestb_local_.close.left = FALSE;
-	  ffestb_local_.close.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.close.close_spec[ffestb_local_.close.ix]
-	  .kw_or_val_present)
-	break;			/* Can't specify a keyword twice! */
-      ffestp_file.close.close_spec[ffestb_local_.close.ix]
-	.kw_or_val_present = TRUE;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix]
-	.kw_present = TRUE;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix]
-	.value_present = FALSE;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].value_is_label
-	= ffestb_local_.close.label;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].kw
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9075_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9075_ -- "CLOSE" OPEN_PAREN [external-file-unit COMMA] NAME
-
-   return ffestb_R9075_;  // to lexer
-
-   Make sure EQUALS here, send next token to expression handler.  */
-
-static ffelexHandler
-ffestb_R9075_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestb_local_.close.label)
-	return (ffelexHandler) ffestb_R9077_;
-      if (ffestb_local_.close.left)
-	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					    ffestb_local_.close.context,
-					    (ffeexprCallback) ffestb_R9076_);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_local_.close.context,
-					  (ffeexprCallback) ffestb_R9076_);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9076_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS expr
-
-   (ffestb_R9076_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9076_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
-	= TRUE;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].value
-	= ffelex_token_use (ft);
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9074_;
-      return (ffelexHandler) ffestb_R9079_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9077_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS
-
-   return ffestb_R9077_;  // to lexer
-
-   Handle NUMBER for label here.  */
-
-static ffelexHandler
-ffestb_R9077_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].value_present
-	= TRUE;
-      ffestp_file.close.close_spec[ffestb_local_.close.ix].value
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9078_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9078_ -- "CLOSE" OPEN_PAREN ... NAME EQUALS NUMBER
-
-   return ffestb_R9078_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9078_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R9074_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_R9079_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9079_ -- "CLOSE" OPEN_PAREN ... CLOSE_PAREN
-
-   return ffestb_R9079_;  // to lexer
-
-   Handle EOS or SEMICOLON here.  */
-
-static ffelexHandler
-ffestb_R9079_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R907 ();
-      ffestb_subr_kill_close_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_close_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "CLOSE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R909 -- Parse the READ statement
-
-   return ffestb_R909;	// to lexer
-
-   Make sure the statement has a valid form for the READ
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R909 (ffelexToken t)
-{
-  ffelexHandler next;
-  ffestpReadIx ix;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstREAD)
-	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;
-
-	case FFELEX_typeOPEN_PAREN:
-	  for (ix = 0; ix < FFESTP_readix; ++ix)
-	    ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R9092_;
-
-	default:
-	  break;
-	}
-
-      for (ix = 0; ix < FFESTP_readix; ++ix)
-	ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstREAD)
-	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_firstlREAD)
-	    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;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlREAD)
-	    break;
-
-	  for (ix = 0; ix < FFESTP_readix; ++ix)
-	    ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_R9092_;
-
-	default:
-	  break;
-	}
-      for (ix = 0; ix < FFESTP_readix; ++ix)
-	ffestp_file.read.read_spec[ix].kw_or_val_present = FALSE;
-      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	     FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9091_);
-      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
-						   FFESTR_firstlREAD);
-      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, "READ", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R9091_ -- "READ" expr
-
-   (ffestb_R9091_)  // to expression handler
-
-   Make sure the next token is a COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R9091_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
-	= TRUE;
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
-	= (expr == NULL);
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
-	= ffelex_token_use (ft);
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
-      if (!ffesta_is_inhibited ())
-	ffestc_R909_start (TRUE);
-      ffestb_subr_kill_read_ ();
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					    ffestc_context_iolist (),
-					  (ffeexprCallback) ffestb_R90915_);
-      if (!ffesta_is_inhibited ())
-	ffestc_R909_finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9092_ -- "READ" OPEN_PAREN
-
-   return ffestb_R9092_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9092_ (ffelexToken t)
-{
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9093_;
-
-    default:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9093_ -- "READ" OPEN_PAREN NAME
-
-   return ffestb_R9093_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9093_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-  ffelexToken ot;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffelex_token_kill (ffesta_tokens[1]);
-      nt = ffesta_tokens[2];
-      next = (ffelexHandler) ffestb_R9098_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      nt = ffesta_tokens[1];
-      ot = ffesta_tokens[2];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEUNITAMBIG, (ffeexprCallback) ffestb_R9094_)))
-	(nt);
-      ffelex_token_kill (nt);
-      next = (ffelexHandler) (*next) (ot);
-      ffelex_token_kill (ot);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9094_ -- "READ" OPEN_PAREN expr [CLOSE_PAREN]
-
-   (ffestb_R9094_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.
-
-   15-Feb-91  JCB  1.1
-      Use new ffeexpr mechanism whereby the expr is encased in an opITEM if
-      ffeexpr decided it was an item in a control list (hence a unit
-      specifier), or a format specifier otherwise.  */
-
-static ffelexHandler
-ffestb_R9094_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  if (expr == NULL)
-    goto bad;			/* :::::::::::::::::::: */
-
-  if (ffebld_op (expr) != FFEBLD_opITEM)
-    {
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
-	    = TRUE;
-	  ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
-	  ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
-	  ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
-	    = FALSE;
-	  ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
-	    = ffelex_token_use (ft);
-	  ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R909_start (TRUE);
-	  ffestb_subr_kill_read_ ();
-	  if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	    return (ffelexHandler)
-	      ffeexpr_lhs (ffesta_output_pool,
-			   ffestc_context_iolist (),
-			   (ffeexprCallback) ffestb_R90915_);
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R909_finish ();
-	  return (ffelexHandler) ffesta_zero (t);
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-    }
-
-  expr = ffebld_head (expr);
-
-  if (expr == NULL)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.read.read_spec[FFESTP_readixUNIT].kw_present = FALSE;
-      ffestp_file.read.read_spec[FFESTP_readixUNIT].value_present = TRUE;
-      ffestp_file.read.read_spec[FFESTP_readixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.read.read_spec[FFESTP_readixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.read.read_spec[FFESTP_readixUNIT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9095_;
-      return (ffelexHandler) ffestb_R90913_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9095_ -- "READ" OPEN_PAREN expr COMMA
-
-   return ffestb_R9095_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9095_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9096_;
-
-    default:
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
-	(t);
-    }
-}
-
-/* ffestb_R9096_ -- "READ" OPEN_PAREN expr COMMA NAME
-
-   return ffestb_R9096_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9096_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) ffestb_R9098_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9097_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9097_ -- "READ" OPEN_PAREN expr COMMA expr
-
-   (ffestb_R9097_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9097_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_or_val_present
-	= TRUE;
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].kw_present = FALSE;
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_present = TRUE;
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].value_is_label
-	= (expr == NULL);
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].value
-	= ffelex_token_use (ft);
-      ffestp_file.read.read_spec[FFESTP_readixFORMAT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9098_;
-      return (ffelexHandler) ffestb_R90913_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9098_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
-		   COMMA]]
-
-   return ffestb_R9098_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9098_ (ffelexToken t)
-{
-  ffestrGenio kw;
-
-  ffestb_local_.read.label = FALSE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      kw = ffestr_genio (t);
-      switch (kw)
-	{
-	case FFESTR_genioADVANCE:
-	  ffestb_local_.read.ix = FFESTP_readixADVANCE;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_genioEOR:
-	  ffestb_local_.read.ix = FFESTP_readixEOR;
-	  ffestb_local_.read.label = TRUE;
-	  break;
-
-	case FFESTR_genioERR:
-	  ffestb_local_.read.ix = FFESTP_readixERR;
-	  ffestb_local_.read.label = TRUE;
-	  break;
-
-	case FFESTR_genioEND:
-	  ffestb_local_.read.ix = FFESTP_readixEND;
-	  ffestb_local_.read.label = TRUE;
-	  break;
-
-	case FFESTR_genioFMT:
-	  ffestb_local_.read.ix = FFESTP_readixFORMAT;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	case FFESTR_genioIOSTAT:
-	  ffestb_local_.read.ix = FFESTP_readixIOSTAT;
-	  ffestb_local_.read.left = TRUE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_genioKEY:
-	case FFESTR_genioKEYEQ:
-	  ffestb_local_.read.ix = FFESTP_readixKEYEQ;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
-	  break;
-
-	case FFESTR_genioKEYGE:
-	  ffestb_local_.read.ix = FFESTP_readixKEYGE;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
-	  break;
-
-	case FFESTR_genioKEYGT:
-	  ffestb_local_.read.ix = FFESTP_readixKEYGT;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILENUMCHAR;
-	  break;
-
-	case FFESTR_genioKEYID:
-	  ffestb_local_.read.ix = FFESTP_readixKEYID;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_genioNML:
-	  ffestb_local_.read.ix = FFESTP_readixFORMAT;
-	  ffestb_local_.read.left = TRUE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILENAMELIST;
-	  break;
-
-	case FFESTR_genioNULLS:
-	  ffestb_local_.read.ix = FFESTP_readixNULLS;
-	  ffestb_local_.read.left = TRUE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_genioREC:
-	  ffestb_local_.read.ix = FFESTP_readixREC;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_genioSIZE:
-	  ffestb_local_.read.ix = FFESTP_readixSIZE;
-	  ffestb_local_.read.left = TRUE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_genioUNIT:
-	  ffestb_local_.read.ix = FFESTP_readixUNIT;
-	  ffestb_local_.read.left = FALSE;
-	  ffestb_local_.read.context = FFEEXPR_contextFILEUNIT;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[ffestb_local_.read.ix]
-	  .kw_or_val_present)
-	break;			/* Can't specify a keyword twice! */
-      ffestp_file.read.read_spec[ffestb_local_.read.ix]
-	.kw_or_val_present = TRUE;
-      ffestp_file.read.read_spec[ffestb_local_.read.ix]
-	.kw_present = TRUE;
-      ffestp_file.read.read_spec[ffestb_local_.read.ix]
-	.value_present = FALSE;
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].value_is_label
-	= ffestb_local_.read.label;
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].kw
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9099_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9099_ -- "READ" OPEN_PAREN [external-file-unit COMMA [format
-		   COMMA]] NAME
-
-   return ffestb_R9099_;  // to lexer
-
-   Make sure EQUALS here, send next token to expression handler.  */
-
-static ffelexHandler
-ffestb_R9099_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestb_local_.read.label)
-	return (ffelexHandler) ffestb_R90911_;
-      if (ffestb_local_.read.left)
-	return (ffelexHandler)
-	  ffeexpr_lhs (ffesta_output_pool,
-		       ffestb_local_.read.context,
-		       (ffeexprCallback) ffestb_R90910_);
-      return (ffelexHandler)
-	ffeexpr_rhs (ffesta_output_pool,
-		     ffestb_local_.read.context,
-		     (ffeexprCallback) ffestb_R90910_);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90910_ -- "READ" OPEN_PAREN ... NAME EQUALS expr
-
-   (ffestb_R90910_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R90910_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	{
-	  if (ffestb_local_.read.context == FFEEXPR_contextFILEFORMAT)
-	    ffestp_file.read.read_spec[ffestb_local_.read.ix]
-	      .value_is_label = TRUE;
-	  else
-	    break;
-	}
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
-	= TRUE;
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].value
-	= ffelex_token_use (ft);
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9098_;
-      return (ffelexHandler) ffestb_R90913_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90911_ -- "READ" OPEN_PAREN ... NAME EQUALS
-
-   return ffestb_R90911_;  // to lexer
-
-   Handle NUMBER for label here.  */
-
-static ffelexHandler
-ffestb_R90911_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].value_present
-	= TRUE;
-      ffestp_file.read.read_spec[ffestb_local_.read.ix].value
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R90912_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90912_ -- "READ" OPEN_PAREN ... NAME EQUALS NUMBER
-
-   return ffestb_R90912_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R90912_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R9098_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_R90913_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90913_ -- "READ" OPEN_PAREN ... CLOSE_PAREN
-
-   return ffestb_R90913_;  // to lexer
-
-   Handle EOS or SEMICOLON here.
-
-   15-Feb-91  JCB  1.1
-      Fix to allow implied-DO construct here (OPEN_PAREN) -- actually,
-      don't presume knowledge of what an initial token in an lhs context
-      is going to be, let ffeexpr_lhs handle that as much as possible.	*/
-
-static ffelexHandler
-ffestb_R90913_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R909_start (FALSE);
-	  ffestc_R909_finish ();
-	}
-      ffestb_subr_kill_read_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_confirmed ();
-      /* Fall through. */
-    case FFELEX_typeOPEN_PAREN:	/* Could still be assignment!! */
-      break;
-    }
-
-  /* If token isn't NAME or OPEN_PAREN, ffeexpr_lhs will ultimately whine
-     about it, so leave it up to that code. */
-
-  /* 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_lhs (ffesta_output_pool,
-		   ffestc_context_iolist (),
-		   (ffeexprCallback) ffestb_R90914_);
-
-  return (ffelexHandler) (*((ffelexHandler)
-			    ffeexpr_lhs (ffesta_output_pool,
-					 ffestc_context_iolist (),
-					 (ffeexprCallback) ffestb_R90914_)))
-    (t);
-}
-
-/* ffestb_R90914_ -- "READ(...)" expr
-
-   (ffestb_R90914_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R90914_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R909_start (FALSE);
-      ffestb_subr_kill_read_ ();
-
-      if (!ffesta_is_inhibited ())
-	ffestc_R909_item (expr, ft);
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  ffestc_context_iolist (),
-					  (ffeexprCallback) ffestb_R90915_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R909_start (FALSE);
-      ffestb_subr_kill_read_ ();
-
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R909_item (expr, ft);
-	  ffestc_R909_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_read_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R90915_ -- "READ(...)" expr COMMA expr
-
-   (ffestb_R90915_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R90915_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R909_item (expr, ft);
-      return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					  ffestc_context_iolist (),
-					  (ffeexprCallback) ffestb_R90915_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R909_item (expr, ft);
-	  ffestc_R909_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R909_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "READ", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R910 -- Parse the WRITE statement
-
-   return ffestb_R910;	// to lexer
-
-   Make sure the statement has a valid form for the WRITE
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R910 (ffelexToken t)
-{
-  ffestpWriteIx ix;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstWRITE)
-	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_writeix; ++ix)
-	    ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
-	  return (ffelexHandler) ffestb_R9101_;
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstWRITE)
-	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_firstlWRITE)
-	    goto bad_0;		/* :::::::::::::::::::: */
-
-	  for (ix = 0; ix < FFESTP_writeix; ++ix)
-	    ffestp_file.write.write_spec[ix].kw_or_val_present = FALSE;
-	  return (ffelexHandler) ffestb_R9101_;
-	}
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R9101_ -- "WRITE" OPEN_PAREN
-
-   return ffestb_R9101_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9101_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9102_;
-
-    default:
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
-	(t);
-    }
-}
-
-/* ffestb_R9102_ -- "WRITE" OPEN_PAREN NAME
-
-   return ffestb_R9102_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9102_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) ffestb_R9107_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		 FFEEXPR_contextFILEUNIT, (ffeexprCallback) ffestb_R9103_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9103_ -- "WRITE" OPEN_PAREN expr [CLOSE_PAREN]
-
-   (ffestb_R9103_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R9103_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.write.write_spec[FFESTP_writeixUNIT].kw_present = FALSE;
-      ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_present = TRUE;
-      ffestp_file.write.write_spec[FFESTP_writeixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.write.write_spec[FFESTP_writeixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.write.write_spec[FFESTP_writeixUNIT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9104_;
-      return (ffelexHandler) ffestb_R91012_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9104_ -- "WRITE" OPEN_PAREN expr COMMA
-
-   return ffestb_R9104_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9104_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9105_;
-
-    default:
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
-	(t);
-    }
-}
-
-/* ffestb_R9105_ -- "WRITE" OPEN_PAREN expr COMMA NAME
-
-   return ffestb_R9105_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9105_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) ffestb_R9107_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9106_)))
-	(nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9106_ -- "WRITE" OPEN_PAREN expr COMMA expr
-
-   (ffestb_R9106_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9106_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_or_val_present
-	= TRUE;
-      ffestp_file.write.write_spec[FFESTP_writeixFORMAT].kw_present = FALSE;
-      ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_present = TRUE;
-      ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value_is_label
-	= (expr == NULL);
-      ffestp_file.write.write_spec[FFESTP_writeixFORMAT].value
-	= ffelex_token_use (ft);
-      ffestp_file.write.write_spec[FFESTP_writeixFORMAT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9107_;
-      return (ffelexHandler) ffestb_R91012_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9107_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
-		   COMMA]]
-
-   return ffestb_R9107_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9107_ (ffelexToken t)
-{
-  ffestrGenio kw;
-
-  ffestb_local_.write.label = FALSE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      kw = ffestr_genio (t);
-      switch (kw)
-	{
-	case FFESTR_genioADVANCE:
-	  ffestb_local_.write.ix = FFESTP_writeixADVANCE;
-	  ffestb_local_.write.left = FALSE;
-	  ffestb_local_.write.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_genioEOR:
-	  ffestb_local_.write.ix = FFESTP_writeixEOR;
-	  ffestb_local_.write.label = TRUE;
-	  break;
-
-	case FFESTR_genioERR:
-	  ffestb_local_.write.ix = FFESTP_writeixERR;
-	  ffestb_local_.write.label = TRUE;
-	  break;
-
-	case FFESTR_genioFMT:
-	  ffestb_local_.write.ix = FFESTP_writeixFORMAT;
-	  ffestb_local_.write.left = FALSE;
-	  ffestb_local_.write.context = FFEEXPR_contextFILEFORMAT;
-	  break;
-
-	case FFESTR_genioIOSTAT:
-	  ffestb_local_.write.ix = FFESTP_writeixIOSTAT;
-	  ffestb_local_.write.left = TRUE;
-	  ffestb_local_.write.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_genioNML:
-	  ffestb_local_.write.ix = FFESTP_writeixFORMAT;
-	  ffestb_local_.write.left = TRUE;
-	  ffestb_local_.write.context = FFEEXPR_contextFILENAMELIST;
-	  break;
-
-	case FFESTR_genioREC:
-	  ffestb_local_.write.ix = FFESTP_writeixREC;
-	  ffestb_local_.write.left = FALSE;
-	  ffestb_local_.write.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	case FFESTR_genioUNIT:
-	  ffestb_local_.write.ix = FFESTP_writeixUNIT;
-	  ffestb_local_.write.left = FALSE;
-	  ffestb_local_.write.context = FFEEXPR_contextFILEUNIT;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.write.write_spec[ffestb_local_.write.ix]
-	  .kw_or_val_present)
-	break;			/* Can't specify a keyword twice! */
-      ffestp_file.write.write_spec[ffestb_local_.write.ix]
-	.kw_or_val_present = TRUE;
-      ffestp_file.write.write_spec[ffestb_local_.write.ix]
-	.kw_present = TRUE;
-      ffestp_file.write.write_spec[ffestb_local_.write.ix]
-	.value_present = FALSE;
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].value_is_label
-	= ffestb_local_.write.label;
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].kw
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9108_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9108_ -- "WRITE" OPEN_PAREN [external-file-unit COMMA [format
-		   COMMA]] NAME
-
-   return ffestb_R9108_;  // to lexer
-
-   Make sure EQUALS here, send next token to expression handler.  */
-
-static ffelexHandler
-ffestb_R9108_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestb_local_.write.label)
-	return (ffelexHandler) ffestb_R91010_;
-      if (ffestb_local_.write.left)
-	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					    ffestb_local_.write.context,
-					    (ffeexprCallback) ffestb_R9109_);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_local_.write.context,
-					  (ffeexprCallback) ffestb_R9109_);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9109_ -- "WRITE" OPEN_PAREN ... NAME EQUALS expr
-
-   (ffestb_R9109_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9109_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	{
-	  if (ffestb_local_.write.context == FFEEXPR_contextFILEFORMAT)
-	    ffestp_file.write.write_spec[ffestb_local_.write.ix]
-	      .value_is_label = TRUE;
-	  else
-	    break;
-	}
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
-	= TRUE;
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].value
-	= ffelex_token_use (ft);
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9107_;
-      return (ffelexHandler) ffestb_R91012_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91010_ -- "WRITE" OPEN_PAREN ... NAME EQUALS
-
-   return ffestb_R91010_;  // to lexer
-
-   Handle NUMBER for label here.  */
-
-static ffelexHandler
-ffestb_R91010_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].value_present
-	= TRUE;
-      ffestp_file.write.write_spec[ffestb_local_.write.ix].value
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R91011_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91011_ -- "WRITE" OPEN_PAREN ... NAME EQUALS NUMBER
-
-   return ffestb_R91011_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R91011_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R9107_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_R91012_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91012_ -- "WRITE" OPEN_PAREN ... CLOSE_PAREN
-
-   return ffestb_R91012_;  // to lexer
-
-   Handle EOS or SEMICOLON here.  */
-
-static ffelexHandler
-ffestb_R91012_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R910_start ();
-	  ffestc_R910_finish ();
-	}
-      ffestb_subr_kill_write_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_confirmed ();
-      /* Fall through. */
-    case FFELEX_typeOPEN_PAREN:	/* Could still be assignment!! */
-
-      /* 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,
-		ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_);
-
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	       ffestc_context_iolist (), (ffeexprCallback) ffestb_R91013_)))
-	(t);
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91013_ -- "WRITE(...)" expr
-
-   (ffestb_R91013_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R91013_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R910_start ();
-      ffestb_subr_kill_write_ ();
-
-      if (!ffesta_is_inhibited ())
-	ffestc_R910_item (expr, ft);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R910_start ();
-      ffestb_subr_kill_write_ ();
-
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R910_item (expr, ft);
-	  ffestc_R910_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_write_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R91014_ -- "WRITE(...)" expr COMMA expr
-
-   (ffestb_R91014_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R91014_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R910_item (expr, ft);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		ffestc_context_iolist (), (ffeexprCallback) ffestb_R91014_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R910_item (expr, ft);
-	  ffestc_R910_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R910_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "WRITE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R911 -- Parse the PRINT statement
-
-   return ffestb_R911;	// to lexer
-
-   Make sure the statement has a valid form for the PRINT
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R911 (ffelexToken t)
-{
-  ffelexHandler next;
-  ffestpPrintIx ix;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstPRINT)
-	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_printix; ++ix)
-	ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstPRINT)
-	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_firstlPRINT)
-	    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_printix; ++ix)
-	ffestp_file.print.print_spec[ix].kw_or_val_present = FALSE;
-      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	     FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_R9111_);
-      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
-						   FFESTR_firstlPRINT);
-      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, "PRINT", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R9111_ -- "PRINT" expr
-
-   (ffestb_R9111_)  // to expression handler
-
-   Make sure the next token is a COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R9111_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_or_val_present
-	= TRUE;
-      ffestp_file.print.print_spec[FFESTP_printixFORMAT].kw_present = FALSE;
-      ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_present = TRUE;
-      ffestp_file.print.print_spec[FFESTP_printixFORMAT].value_is_label
-	= (expr == NULL);
-      ffestp_file.print.print_spec[FFESTP_printixFORMAT].value
-	= ffelex_token_use (ft);
-      ffestp_file.print.print_spec[FFESTP_printixFORMAT].u.expr = expr;
-      if (!ffesta_is_inhibited ())
-	ffestc_R911_start ();
-      ffestb_subr_kill_print_ ();
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		    FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
-      if (!ffesta_is_inhibited ())
-	ffestc_R911_finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_print_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9112_ -- "PRINT" expr COMMA expr
-
-   (ffestb_R9112_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R9112_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R911_item (expr, ft);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		    FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R9112_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R911_item (expr, ft);
-	  ffestc_R911_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R911_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PRINT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R923 -- Parse an INQUIRE statement
-
-   return ffestb_R923;	// to lexer
-
-   Make sure the statement has a valid form for an INQUIRE statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_R923 (ffelexToken t)
-{
-  ffestpInquireIx ix;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstINQUIRE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      break;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstINQUIRE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlINQUIRE)
-	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_inquireix; ++ix)
-    ffestp_file.inquire.inquire_spec[ix].kw_or_val_present = FALSE;
-
-  ffestb_local_.inquire.may_be_iolength = TRUE;
-  return (ffelexHandler) ffestb_R9231_;
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_R9231_ -- "INQUIRE" OPEN_PAREN
-
-   return ffestb_R9231_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9231_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9232_;
-
-    default:
-      ffestb_local_.inquire.may_be_iolength = FALSE;
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
-	(t);
-    }
-}
-
-/* ffestb_R9232_ -- "INQUIRE" OPEN_PAREN NAME
-
-   return ffestb_R9232_;  // to lexer
-
-   If EQUALS here, go to states that handle it.	 Else, send NAME and this
-   token thru expression handler.  */
-
-static ffelexHandler
-ffestb_R9232_ (ffelexToken t)
-{
-  ffelexHandler next;
-  ffelexToken nt;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      nt = ffesta_tokens[1];
-      next = (ffelexHandler) ffestb_R9234_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      ffestb_local_.inquire.may_be_iolength = FALSE;
-      next = (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextFILENUM, (ffeexprCallback) ffestb_R9233_)))
-	(ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) (*next) (t);
-    }
-}
-
-/* ffestb_R9233_ -- "INQUIRE" OPEN_PAREN expr
-
-   (ffestb_R9233_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9233_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present
-	= TRUE;
-      ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present = FALSE;
-      ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_present = TRUE;
-      ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value_is_label
-	= FALSE;
-      ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value
-	= ffelex_token_use (ft);
-      ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9234_;
-      return (ffelexHandler) ffestb_R9239_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9234_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA]
-
-   return ffestb_R9234_;  // to lexer
-
-   Handle expr construct (not NAME=expr construct) here.  */
-
-static ffelexHandler
-ffestb_R9234_ (ffelexToken t)
-{
-  ffestrInquire kw;
-
-  ffestb_local_.inquire.label = FALSE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      kw = ffestr_inquire (t);
-      if (kw != FFESTR_inquireIOLENGTH)
-	ffestb_local_.inquire.may_be_iolength = FALSE;
-      switch (kw)
-	{
-	case FFESTR_inquireACCESS:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixACCESS;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireACTION:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixACTION;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireBLANK:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixBLANK;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireCARRIAGECONTROL:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixCARRIAGECONTROL;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquireDEFAULTFILE:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixDEFAULTFILE;
-	  ffestb_local_.inquire.left = FALSE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquireDELIM:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixDELIM;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireDIRECT:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixDIRECT;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireERR:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixERR;
-	  ffestb_local_.inquire.label = TRUE;
-	  break;
-
-	case FFESTR_inquireEXIST:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixEXIST;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
-	  break;
-
-	case FFESTR_inquireFILE:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixFILE;
-	  ffestb_local_.inquire.left = FALSE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquireFORM:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixFORM;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireFORMATTED:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixFORMATTED;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireIOLENGTH:
-	  if (!ffestb_local_.inquire.may_be_iolength)
-	    goto bad;		/* :::::::::::::::::::: */
-	  ffestb_local_.inquire.ix = FFESTP_inquireixIOLENGTH;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_inquireIOSTAT:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixIOSTAT;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_inquireKEYED:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixKEYED;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquireNAME:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixNAME;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquireNAMED:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixNAMED;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
-	  break;
-
-	case FFESTR_inquireNEXTREC:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixNEXTREC;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFINT;
-	  break;
-
-	case FFESTR_inquireNUMBER:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixNUMBER;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_inquireOPENED:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixOPENED;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILELOG;
-	  break;
-
-	case FFESTR_inquireORGANIZATION:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixORGANIZATION;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquirePAD:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixPAD;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquirePOSITION:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixPOSITION;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireREAD:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixREAD;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireREADWRITE:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixREADWRITE;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireRECL:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixRECL;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEINT;
-	  break;
-
-	case FFESTR_inquireRECORDTYPE:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixRECORDTYPE;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILECHAR;
-	  break;
-
-	case FFESTR_inquireSEQUENTIAL:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixSEQUENTIAL;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireUNFORMATTED:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixUNFORMATTED;
-	  ffestb_local_.inquire.left = TRUE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILEDFCHAR;
-	  break;
-
-	case FFESTR_inquireUNIT:
-	  ffestb_local_.inquire.ix = FFESTP_inquireixUNIT;
-	  ffestb_local_.inquire.left = FALSE;
-	  ffestb_local_.inquire.context = FFEEXPR_contextFILENUM;
-	  break;
-
-	default:
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
-	  .kw_or_val_present)
-	break;			/* Can't specify a keyword twice! */
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
-	.kw_or_val_present = TRUE;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
-	.kw_present = TRUE;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix]
-	.value_present = FALSE;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_is_label
-	= ffestb_local_.inquire.label;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].kw
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9235_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9235_ -- "INQUIRE" OPEN_PAREN [external-file-unit COMMA] NAME
-
-   return ffestb_R9235_;  // to lexer
-
-   Make sure EQUALS here, send next token to expression handler.  */
-
-static ffelexHandler
-ffestb_R9235_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (ffestb_local_.inquire.label)
-	return (ffelexHandler) ffestb_R9237_;
-      if (ffestb_local_.inquire.left)
-	return (ffelexHandler) ffeexpr_lhs (ffesta_output_pool,
-					    ffestb_local_.inquire.context,
-					    (ffeexprCallback) ffestb_R9236_);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_local_.inquire.context,
-					  (ffeexprCallback) ffestb_R9236_);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9236_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS expr
-
-   (ffestb_R9236_)  // to expression handler
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9236_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
-	break;			/* IOLENGTH=expr must be followed by
-				   CLOSE_PAREN. */
-      /* Fall through. */
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
-	= TRUE;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
-	= ffelex_token_use (ft);
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].u.expr = expr;
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_R9234_;
-      if (ffestb_local_.inquire.ix == FFESTP_inquireixIOLENGTH)
-	return (ffelexHandler) ffestb_R92310_;
-      return (ffelexHandler) ffestb_R9239_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9237_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS
-
-   return ffestb_R9237_;  // to lexer
-
-   Handle NUMBER for label here.  */
-
-static ffelexHandler
-ffestb_R9237_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value_present
-	= TRUE;
-      ffestp_file.inquire.inquire_spec[ffestb_local_.inquire.ix].value
-	= ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R9238_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9238_ -- "INQUIRE" OPEN_PAREN ... NAME EQUALS NUMBER
-
-   return ffestb_R9238_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN here.  */
-
-static ffelexHandler
-ffestb_R9238_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_R9234_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_R9239_;
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R9239_ -- "INQUIRE" OPEN_PAREN ... CLOSE_PAREN
-
-   return ffestb_R9239_;  // to lexer
-
-   Handle EOS or SEMICOLON here.  */
-
-static ffelexHandler
-ffestb_R9239_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R923A ();
-      ffestb_subr_kill_inquire_ ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R92310_ -- "INQUIRE(IOLENGTH=expr)"
-
-   return ffestb_R92310_;  // to lexer
-
-   Make sure EOS or SEMICOLON not here; begin R923B processing and expect
-   output IO list.  */
-
-static ffelexHandler
-ffestb_R92310_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      break;
-
-    default:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R923B_start ();
-      ffestb_subr_kill_inquire_ ();
-      return (ffelexHandler) (*((ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		  FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_)))
-	(t);
-    }
-
-  ffestb_subr_kill_inquire_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R92311_ -- "INQUIRE(IOLENGTH=expr)" expr
-
-   (ffestb_R92311_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_R92311_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_R923B_item (expr, ft);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		   FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_R92311_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R923B_item (expr, ft);
-	  ffestc_R923B_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R923B_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "INQUIRE", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V020 -- Parse the TYPE statement
-
-   return ffestb_V020;	// to lexer
-
-   Make sure the statement has a valid form for the TYPE
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_V020 (ffelexToken t)
-{
-  ffeTokenLength i;
-  const char *p;
-  ffelexHandler next;
-  ffestpTypeIx ix;
-
-  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_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:
-	case FFELEX_typeCOMMA:	/* Because "TYPE,PUBLIC::A" is ambiguous with
-				   '90. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeNUMBER:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeNAME:	/* Because TYPE A is ambiguous with '90. */
-	default:
-	  break;
-	}
-
-      for (ix = 0; ix < FFESTP_typeix; ++ix)
-	ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
-      return (ffelexHandler) (*((ffelexHandler)
-				ffeexpr_rhs (ffesta_output_pool,
-	    FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_)))
-	(t);
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstTYPE)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeCOMMA:
-	  if (ffelex_token_length (ffesta_tokens[0]) != FFESTR_firstlTYPE)
-	    break;
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (ffelex_token_length (ffesta_tokens[0]) == FFESTR_firstlTYPE)
-	    break;		/* Else might be assignment/stmtfuncdef. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEQUALS:
-	case FFELEX_typePOINTS:
-	case FFELEX_typeCOLON:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  break;
-	}
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlTYPE);
-      if (ISDIGIT (*p))
-	ffesta_confirmed ();	/* Else might be '90 TYPE statement. */
-      for (ix = 0; ix < FFESTP_typeix; ++ix)
-	ffestp_file.type.type_spec[ix].kw_or_val_present = FALSE;
-      next = (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-	     FFEEXPR_contextFILEFORMATNML, (ffeexprCallback) ffestb_V0201_);
-      next = (ffelexHandler) ffelex_splice_tokens (next, ffesta_tokens[0],
-						   FFESTR_firstlTYPE);
-      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, "TYPE I/O", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_V0201_ -- "TYPE" expr
-
-   (ffestb_V0201_)  // to expression handler
-
-   Make sure the next token is a COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_V0201_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  bool comma = TRUE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffe_is_vxt () && (expr != NULL)
-	  && (ffebld_op (expr) == FFEBLD_opSYMTER))
-	break;
-      comma = FALSE;
-      /* Fall through. */
-    case FFELEX_typeCOMMA:
-      if (!ffe_is_vxt () && comma && (expr != NULL)
-	  && (ffebld_op (expr) == FFEBLD_opPAREN)
-	  && (ffebld_op (ffebld_left (expr)) == FFEBLD_opSYMTER))
-	break;
-      ffesta_confirmed ();
-      ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_or_val_present
-	= TRUE;
-      ffestp_file.type.type_spec[FFESTP_typeixFORMAT].kw_present = FALSE;
-      ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_present = TRUE;
-      ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value_is_label
-	= (expr == NULL);
-      ffestp_file.type.type_spec[FFESTP_typeixFORMAT].value
-	= ffelex_token_use (ft);
-      ffestp_file.type.type_spec[FFESTP_typeixFORMAT].u.expr = expr;
-      if (!ffesta_is_inhibited ())
-	ffestc_V020_start ();
-      ffestb_subr_kill_type_ ();
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		    FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
-      if (!ffesta_is_inhibited ())
-	ffestc_V020_finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestb_subr_kill_type_ ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0202_ -- "TYPE" expr COMMA expr
-
-   (ffestb_V0202_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON here.	*/
-
-static ffelexHandler
-ffestb_V0202_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_V020_item (expr, ft);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		    FFEEXPR_contextIOLIST, (ffeexprCallback) ffestb_V0202_);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_V020_item (expr, ft);
-	  ffestc_V020_finish ();
-	}
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_V020_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "TYPE I/O", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dummy -- Parse an ENTRY/FUNCTION/SUBROUTINE statement
-
-   return ffestb_dummy;	 // to lexer
-
-   Make sure the statement has a valid form for an ENTRY/FUNCTION/SUBROUTINE
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_dummy (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      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 ();
-      ffesta_tokens[1] = ffelex_token_use (t);
-      ffestb_local_.decl.recursive = NULL;
-      ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
-      ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
-      ffestb_local_.dummy.first_kw = ffesta_first_kw;
-      return (ffelexHandler) ffestb_dummy1_;
-
-    case FFELEX_typeNAMES:
-      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_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeOPEN_PAREN:
-	  break;
-	}
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.dummy.len);
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffesta_tokens[1]
-	= ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      ffestb_local_.decl.recursive = NULL;
-      ffestb_local_.dummy.badname = ffestb_args.dummy.badname;
-      ffestb_local_.dummy.is_subr = ffestb_args.dummy.is_subr;
-      ffestb_local_.dummy.first_kw = ffesta_first_kw;
-      return (ffelexHandler) ffestb_dummy1_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.badname, ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.dummy.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.dummy.badname, ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dummy1_ -- "ENTRY/FUNCTION/SUBROUTINE" NAME
-
-   return ffestb_dummy1_;  // to lexer
-
-   Make sure the next token is an EOS, SEMICOLON, or OPEN_PAREN.  In the
-   former case, just implement a null arg list, else get the arg list and
-   then implement.  */
-
-static ffelexHandler
-ffestb_dummy1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (ffestb_local_.dummy.first_kw == FFESTR_firstFUNCTION)
-	{
-	  ffesta_confirmed ();	/* Later, not if typename w/o RECURSIVE. */
-	  break;		/* Produce an error message, need that open
-				   paren. */
-	}
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{			/* Pretend as though we got a truly NULL
-				   list. */
-	  ffestb_subrargs_.name_list.args = NULL;
-	  ffestb_subrargs_.name_list.ok = TRUE;
-	  ffestb_subrargs_.name_list.close_paren = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_dummy2_ (t);
-	}
-      if (ffestb_local_.decl.recursive != NULL)
-	ffelex_token_kill (ffestb_local_.decl.recursive);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
-      ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_dummy2_;
-      ffestb_subrargs_.name_list.is_subr = ffestb_local_.dummy.is_subr;
-      ffestb_subrargs_.name_list.names = FALSE;
-      return (ffelexHandler) ffestb_subr_name_list_;
-
-    default:
-      break;
-    }
-
-  if (ffestb_local_.decl.recursive != NULL)
-    ffelex_token_kill (ffestb_local_.decl.recursive);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_dummy2_ -- <dummy-keyword> NAME OPEN_PAREN arg-list CLOSE_PAREN
-
-   return ffestb_dummy2_;  // to lexer
-
-   Make sure the statement has a valid form for a dummy-def statement.	If it
-   does, implement the statement.  */
-
-static ffelexHandler
-ffestb_dummy2_ (ffelexToken t)
-{
-  if (!ffestb_subrargs_.name_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  switch (ffestb_local_.dummy.first_kw)
-	    {
-	    case FFESTR_firstFUNCTION:
-	      ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
-		    ffestb_subrargs_.name_list.close_paren, FFESTP_typeNone,
-		NULL, NULL, NULL, NULL, ffestb_local_.decl.recursive, NULL);
-	      break;
-
-	    case FFESTR_firstSUBROUTINE:
-	      ffestc_R1223 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
-			    ffestb_subrargs_.name_list.close_paren,
-			    ffestb_local_.decl.recursive);
-	      break;
-
-	    case FFESTR_firstENTRY:
-	      ffestc_R1226 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
-			    ffestb_subrargs_.name_list.close_paren);
-	      break;
-
-	    default:
-	      assert (FALSE);
-	    }
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.recursive != NULL)
-	ffelex_token_kill (ffestb_local_.decl.recursive);
-      ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-      if (ffestb_subrargs_.name_list.args != NULL)
-	ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeNAME:
-      ffesta_confirmed ();
-      if ((ffestb_local_.dummy.first_kw != FFESTR_firstFUNCTION)
-	  || (ffestr_other (t) != FFESTR_otherRESULT))
-	break;
-      ffestb_local_.decl.type = FFESTP_typeNone;
-      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_6_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_local_.dummy.badname, t);
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.decl.recursive != NULL)
-    ffelex_token_kill (ffestb_local_.decl.recursive);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  if (ffestb_subrargs_.name_list.args != NULL)
-    ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R524 -- Parse the DIMENSION statement
-
-   return ffestb_R524;	// to lexer
-
-   Make sure the statement has a valid form for the DIMENSION statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R524 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned 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_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_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
-	  ffestb_local_.dimension.started = TRUE;
-	  return (ffelexHandler) ffestb_R5241_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.R524.len);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeCOLONCOLON:
-	  ffesta_confirmed ();
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  break;
-	}
-
-      /* Here, we have at least one char after "DIMENSION" and t is
-	 OPEN_PAREN. */
-
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      nt = ffelex_token_name_from_names (ffesta_tokens[0], i, 0);
-      ffestb_local_.dimension.started = FALSE;
-      next = (ffelexHandler) ffestb_R5241_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.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.R524.badname, ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5241_ -- "DIMENSION"
-
-   return ffestb_R5241_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_R5241_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R5242_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R524_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5242_ -- "DIMENSION" ... NAME
-
-   return ffestb_R5242_;  // to lexer
-
-   Handle OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_R5242_ (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_R5243_;
-      ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
-      ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
-	? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
-      ffestb_subrargs_.dim_list.ndims = 0;
-#endif
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_subrargs_.dim_list.ctx,
-				    (ffeexprCallback) ffestb_subr_dimlist_);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R524_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5243_ -- "DIMENSION" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
-
-   return ffestb_R5243_;  // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R5243_ (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_.dimension.started)
-	    {
-	      ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
-	      ffestb_local_.dimension.started = TRUE;
-	    }
-	  ffestc_R524_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_R5244_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.dimension.started)
-	    {
-	      ffestc_R524_start (ffesta_first_kw == FFESTR_firstVIRTUAL);
-	      ffestb_local_.dimension.started = TRUE;
-	    }
-	  ffestc_R524_item (ffesta_tokens[1],
-			    ffestb_subrargs_.dim_list.dims);
-	  ffestc_R524_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, ffestb_args.R524.badname, t);
-  if (ffestb_local_.dimension.started && !ffesta_is_inhibited ())
-    ffestc_R524_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_R5244_ -- "DIMENSION" ... COMMA
-
-   return ffestb_R5244_;  // to lexer
-
-   Make sure we don't have EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R5244_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R524_finish ();
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, ffestb_args.R524.badname, t);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      return (ffelexHandler) ffestb_R5241_ (t);
-    }
-}
-
-/* ffestb_R547 -- Parse the COMMON statement
-
-   return ffestb_R547;	// to lexer
-
-   Make sure the statement has a valid form for the COMMON statement.  If it
-   does, implement the statement.  */
-
-ffelexHandler
-ffestb_R547 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexToken nt;
-  ffelexHandler next;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCOMMON)
-	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:
-	case FFELEX_typeSLASH:
-	case FFELEX_typeCONCAT:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R547_start ();
-	  ffestb_local_.common.started = TRUE;
-	  return (ffelexHandler) ffestb_R5471_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstCOMMON)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCOMMON);
-      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:
-	case FFELEX_typeCONCAT:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R547_start ();
-	  ffestb_local_.common.started = TRUE;
-	  return (ffelexHandler) ffestb_R5471_ (t);
-
-	case FFELEX_typeOPEN_PAREN:
-	  break;
-	}
-
-      /* Here, we have at least one char after "COMMON" and t is COMMA,
-	 EOS/SEMICOLON, OPEN_PAREN, SLASH, or CONCAT. */
-
-      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_.common.started = FALSE;
-      else
-	{
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R547_start ();
-	  ffestb_local_.common.started = TRUE;
-	}
-      next = (ffelexHandler) ffestb_R5471_ (nt);
-      ffelex_token_kill (nt);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "COMMON", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5471_ -- "COMMON"
-
-   return ffestb_R5471_;  // to lexer
-
-   Handle NAME, SLASH, or CONCAT.  */
-
-static ffelexHandler
-ffestb_R5471_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      return (ffelexHandler) ffestb_R5474_ (t);
-
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_R5472_;
-
-    case FFELEX_typeCONCAT:
-      if (!ffesta_is_inhibited ())
-	ffestc_R547_item_cblock (NULL);
-      return (ffelexHandler) ffestb_R5474_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R547_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5472_ -- "COMMON" SLASH
-
-   return ffestb_R5472_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_R5472_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R5473_;
-
-    case FFELEX_typeSLASH:
-      if (!ffesta_is_inhibited ())
-	ffestc_R547_item_cblock (NULL);
-      return (ffelexHandler) ffestb_R5474_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R547_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5473_ -- "COMMON" SLASH NAME
-
-   return ffestb_R5473_;  // to lexer
-
-   Handle SLASH.  */
-
-static ffelexHandler
-ffestb_R5473_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeSLASH:
-      if (!ffesta_is_inhibited ())
-	ffestc_R547_item_cblock (ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_R5474_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R547_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5474_ -- "COMMON" [SLASH NAME SLASH] or "COMMON" CONCAT
-
-   return ffestb_R5474_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_R5474_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_R5475_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R547_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5475_ -- "COMMON" ... NAME
-
-   return ffestb_R5475_;  // to lexer
-
-   Handle OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_R5475_ (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_R5476_;
-      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_R547_item_object (ffesta_tokens[1], NULL);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_R5477_;
-
-    case FFELEX_typeSLASH:
-    case FFELEX_typeCONCAT:
-      if (!ffesta_is_inhibited ())
-	ffestc_R547_item_object (ffesta_tokens[1], NULL);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_R5471_ (t);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_R547_item_object (ffesta_tokens[1], NULL);
-	  ffestc_R547_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_R547_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R5476_ -- "COMMON" ... NAME OPEN_PAREN dimlist CLOSE_PAREN
-
-   return ffestb_R5476_;  // to lexer
-
-   Handle COMMA, SLASH, CONCAT, EOS/SEMICOLON.	*/
-
-static ffelexHandler
-ffestb_R5476_ (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_.common.started)
-	    {
-	      ffestc_R547_start ();
-	      ffestb_local_.common.started = TRUE;
-	    }
-	  ffestc_R547_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_R5477_;
-
-    case FFELEX_typeSLASH:
-    case FFELEX_typeCONCAT:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.common.started)
-	    {
-	      ffestc_R547_start ();
-	      ffestb_local_.common.started = TRUE;
-	    }
-	  ffestc_R547_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_R5471_ (t);
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  if (!ffestb_local_.common.started)
-	    ffestc_R547_start ();
-	  ffestc_R547_item_object (ffesta_tokens[1],
-				   ffestb_subrargs_.dim_list.dims);
-	  ffestc_R547_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, "COMMON", t);
-  if (ffestb_local_.common.started && !ffesta_is_inhibited ())
-    ffestc_R547_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_R5477_ -- "COMMON" ... COMMA
-
-   return ffestb_R5477_;  // to lexer
-
-   Make sure we don't have EOS or SEMICOLON.  */
-
-static ffelexHandler
-ffestb_R5477_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R547_finish ();
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "COMMON", t);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      return (ffelexHandler) ffestb_R5471_ (t);
-    }
-}
-
-/* ffestb_R1229 -- Parse a STMTFUNCTION statement
-
-   return ffestb_R1229;	 // to lexer
-
-   Make sure the statement has a valid form for a STMTFUNCTION
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_R1229 (ffelexToken t)
-{
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNAMES:
-      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_subrargs_.name_list.args = ffestt_tokenlist_create ();
-  ffestb_subrargs_.name_list.handler = (ffelexHandler) ffestb_R12291_;
-  ffestb_subrargs_.name_list.is_subr = FALSE;	/* No "*" items in list! */
-  ffestb_subrargs_.name_list.names = TRUE;	/* In case "IF(FOO)CALL
-						   FOO...". */
-  return (ffelexHandler) ffestb_subr_name_list_;
-
-bad_0:				/* :::::::::::::::::::: */
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12291_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
-
-   return ffestb_R12291_;  // to lexer
-
-   Make sure the statement has a valid form for a STMTFUNCTION statement.  If
-   it does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R12291_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  if (!ffestb_subrargs_.name_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R1229_start (ffesta_tokens[0],
-			    ffestb_subrargs_.name_list.args,
-			    ffestb_subrargs_.name_list.close_paren);
-      ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-      ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		 FFEEXPR_contextSFUNCDEF, (ffeexprCallback) ffestb_R12292_);
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffesta_ffebad_2t (FFEBAD_UNREC_STMT, ffesta_tokens[0], t);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_R12292_ -- "STMTFUNCTION" OPEN_PAREN dummy-name-list CLOSE_PAREN
-		     EQUALS expr
-
-   (ffestb_R12292_)  // to expression handler
-
-   Make sure the statement has a valid form for a STMTFUNCTION statement.  If
-   it does, implement the statement.  */
-
-static ffelexHandler
-ffestb_R12292_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  if (expr == NULL)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R1229_finish (expr, ft);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffestc_R1229_finish (NULL, NULL);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "statement-function-definition", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_chartype -- Parse the CHARACTER statement
-
-   return ffestb_decl_chartype;	 // to lexer
-
-   Make sure the statement has a valid form for the CHARACTER statement.  If
-   it does, implement the statement.  */
-
-ffelexHandler
-ffestb_decl_chartype (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  ffestb_local_.decl.type = FFESTP_typeCHARACTER;
-  ffestb_local_.decl.recursive = NULL;
-  ffestb_local_.decl.parameter = FALSE;	/* No PARAMETER attribute seen. */
-  ffestb_local_.decl.coloncolon = FALSE;	/* No COLONCOLON seen. */
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstCHRCTR)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_;
-
-	case FFELEX_typeCOLONCOLON:
-	  ffestb_local_.decl.coloncolon = TRUE;
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_ents_;
-
-	case FFELEX_typeASTERISK:
-	  ffesta_confirmed ();
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_starlen_;
-
-	case FFELEX_typeOPEN_PAREN:
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	  ffestb_local_.decl.len = NULL;
-	  ffestb_local_.decl.lent = NULL;
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
-	  ffestb_local_.decl.badname = "_TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_typeparams_;
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	  ffestb_local_.decl.len = NULL;
-	  ffestb_local_.decl.lent = NULL;
-	  return (ffelexHandler) ffestb_decl_entsp_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstCHRCTR)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlCHRCTR);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_;
-
-	case FFELEX_typeCOLONCOLON:
-	  ffestb_local_.decl.coloncolon = TRUE;
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_ents_;
-
-	case FFELEX_typeASTERISK:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_chartype1_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_starlen_;
-
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (*p != '\0')
-	    break;
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	  ffestb_local_.decl.len = NULL;
-	  ffestb_local_.decl.lent = NULL;
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_typeparams_;
-	}
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
-      return (ffelexHandler) ffestb_decl_entsp_2_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-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. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_chartype1_ -- "CHARACTER" ASTERISK char-length
-
-   return ffestb_decl_chartype1_;  // to lexer
-
-   Handle COMMA, COLONCOLON, or anything else.	*/
-
-static ffelexHandler
-ffestb_decl_chartype1_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOLONCOLON:
-      ffestb_local_.decl.coloncolon = TRUE;
-      /* Fall through. */
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-	       NULL, NULL, ffestb_local_.decl.len, ffestb_local_.decl.lent);
-      if (ffestb_local_.decl.lent != NULL)
-	ffelex_token_kill (ffestb_local_.decl.lent);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    default:
-      return (ffelexHandler) ffestb_decl_entsp_ (t);
-    }
-}
-
-/* ffestb_decl_dbltype -- Parse the DOUBLEPRECISION/DOUBLECOMPLEX statement
-
-   return ffestb_decl_dbltype;	// to lexer
-
-   Make sure the statement has a valid form for the DOUBLEPRECISION/
-   DOUBLECOMPLEX statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_decl_dbltype (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  ffestb_local_.decl.type = ffestb_args.decl.type;
-  ffestb_local_.decl.recursive = NULL;
-  ffestb_local_.decl.parameter = FALSE;	/* No PARAMETER attribute seen. */
-  ffestb_local_.decl.coloncolon = FALSE;	/* No COLONCOLON seen. */
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_;
-
-	case FFELEX_typeCOLONCOLON:
-	  ffestb_local_.decl.coloncolon = TRUE;
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_ents_;
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	  ffestb_local_.decl.len = NULL;
-	  ffestb_local_.decl.lent = NULL;
-	  return (ffelexHandler) ffestb_decl_entsp_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_;
-
-	case FFELEX_typeCOLONCOLON:
-	  ffestb_local_.decl.coloncolon = TRUE;
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_ents_;
-
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (*p != '\0')
-	    break;
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
-      return (ffelexHandler) ffestb_decl_entsp_2_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-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. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_double -- Parse the DOUBLE PRECISION/DOUBLE COMPLEX statement
-
-   return ffestb_decl_double;  // to lexer
-
-   Make sure the statement has a valid form for the DOUBLE PRECISION/
-   DOUBLE COMPLEX statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_decl_double (ffelexToken t)
-{
-  ffestb_local_.decl.recursive = NULL;
-  ffestb_local_.decl.parameter = FALSE;	/* No PARAMETER attribute seen. */
-  ffestb_local_.decl.coloncolon = FALSE;	/* No COLONCOLON seen. */
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstDBL)
-	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:
-	  ffesta_confirmed ();
-	  switch (ffestr_second (t))
-	    {
-	    case FFESTR_secondCOMPLEX:
-	      ffestb_local_.decl.type = FFESTP_typeDBLCMPLX;
-	      break;
-
-	    case FFESTR_secondPRECISION:
-	      ffestb_local_.decl.type = FFESTP_typeDBLPRCSN;
-	      break;
-
-	    default:
-	      goto bad_1;	/* :::::::::::::::::::: */
-	    }
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	  ffestb_local_.decl.len = NULL;
-	  ffestb_local_.decl.lent = NULL;
-	  return (ffelexHandler) ffestb_decl_attrsp_;
-	}
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-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. */
-}
-
-/* ffestb_decl_gentype -- Parse the INTEGER/REAL/COMPLEX/LOGICAL statement
-
-   return ffestb_decl_gentype;	// to lexer
-
-   Make sure the statement has a valid form for the INTEGER/REAL/COMPLEX/
-   LOGICAL statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_decl_gentype (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-
-  ffestb_local_.decl.type = ffestb_args.decl.type;
-  ffestb_local_.decl.recursive = NULL;
-  ffestb_local_.decl.parameter = FALSE;	/* No PARAMETER attribute seen. */
-  ffestb_local_.decl.coloncolon = FALSE;	/* No COLONCOLON seen. */
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();	/* Error, but clearly intended. */
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_;
-
-	case FFELEX_typeCOLONCOLON:
-	  ffestb_local_.decl.coloncolon = TRUE;
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_ents_;
-
-	case FFELEX_typeASTERISK:
-	  ffesta_confirmed ();
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_starkind_;
-
-	case FFELEX_typeOPEN_PAREN:
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_kindparam_;
-
-	case FFELEX_typeNAME:
-	  ffesta_confirmed ();
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = NULL;
-	  ffestb_local_.decl.len = NULL;
-	  ffestb_local_.decl.lent = NULL;
-	  return (ffelexHandler) ffestb_decl_entsp_ (t);
-	}
-
-    case FFELEX_typeNAMES:
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = ffestb_args.decl.len);
-      switch (ffelex_token_type (t))
-	{
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	  ffesta_confirmed ();
-	  break;
-
-	case FFELEX_typeCOMMA:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_;
-
-	case FFELEX_typeCOLONCOLON:
-	  ffestb_local_.decl.coloncolon = TRUE;
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    goto bad_i;		/* :::::::::::::::::::: */
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			       NULL, NULL, NULL, NULL);
-	  return (ffelexHandler) ffestb_decl_ents_;
-
-	case FFELEX_typeSLASH:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  goto bad_1;		/* :::::::::::::::::::: */
-
-	case FFELEX_typeASTERISK:
-	  ffesta_confirmed ();
-	  if (*p != '\0')
-	    break;
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_starkind_;
-
-	case FFELEX_typeOPEN_PAREN:
-	  if (*p != '\0')
-	    break;
-	  ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_attrsp_;
-	  ffestb_local_.decl.badname = "TYPEDECL";
-	  return (ffelexHandler) ffestb_decl_kindparam_;
-	}
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      ffesta_tokens[1] = ffelex_token_names_from_names (ffesta_tokens[0], i, 0);
-      return (ffelexHandler) ffestb_decl_entsp_2_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-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. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "type-declaration", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_ -- "type" [type parameters] COMMA
-
-   return ffestb_decl_attrs_;  // to lexer
-
-   Handle NAME of an attribute.	 */
-
-static ffelexHandler
-ffestb_decl_attrs_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      switch (ffestr_first (t))
-	{
-	case FFESTR_firstDIMENSION:
-	  ffesta_tokens[1] = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_decl_attrs_1_;
-
-	case FFESTR_firstEXTERNAL:
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_attrib (FFESTP_attribEXTERNAL, t,
-				FFESTR_otherNone, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_7_;
-
-	case FFESTR_firstINTRINSIC:
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_attrib (FFESTP_attribINTRINSIC, t,
-				FFESTR_otherNone, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_7_;
-
-	case FFESTR_firstPARAMETER:
-	  ffestb_local_.decl.parameter = TRUE;
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_attrib (FFESTP_attribPARAMETER, t,
-				FFESTR_otherNone, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_7_;
-
-	case FFESTR_firstSAVE:
-	  if (!ffesta_is_inhibited ())
-	    ffestc_decl_attrib (FFESTP_attribSAVE, t,
-				FFESTR_otherNone, NULL);
-	  return (ffelexHandler) ffestb_decl_attrs_7_;
-
-	default:
-	  ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_ATTR, t);
-	  return (ffelexHandler) ffestb_decl_attrs_7_;
-	}
-      break;
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrs_1_ -- "type" [type parameters] ",DIMENSION"
-
-   return ffestb_decl_attrs_1_;	 // to lexer
-
-   Handle OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_attrs_1_ (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_decl_attrs_2_;
-      ffestb_subrargs_.dim_list.pool = ffesta_scratch_pool;
-      ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
-	? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
-      ffestb_subrargs_.dim_list.ndims = 0;
-#endif
-      return (ffelexHandler) ffeexpr_rhs (ffesta_scratch_pool,
-					  ffestb_subrargs_.dim_list.ctx,
-				    (ffeexprCallback) ffestb_subr_dimlist_);
-
-    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_2_ -- "type" [type parameters] ",DIMENSION" OPEN_PAREN
-			  dimlist CLOSE_PAREN
-
-   return ffestb_decl_attrs_2_;	 // to lexer
-
-   Handle COMMA or COLONCOLON.	*/
-
-static ffelexHandler
-ffestb_decl_attrs_2_ (ffelexToken t)
-{
-  if (!ffestb_subrargs_.dim_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeCOLONCOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_attrib (FFESTP_attribDIMENSION, ffesta_tokens[1],
-			  FFESTR_otherNone, ffestb_subrargs_.dim_list.dims);
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      return (ffelexHandler) ffestb_decl_attrs_7_ (t);
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_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_decl_attrs_7_ -- "type" [type parameters] attribute
-
-   return ffestb_decl_attrs_7_;	 // to lexer
-
-   Handle COMMA (another attribute) or COLONCOLON (entities).  */
-
-static ffelexHandler
-ffestb_decl_attrs_7_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_decl_attrs_;
-
-    case FFELEX_typeCOLONCOLON:
-      ffestb_local_.decl.coloncolon = TRUE;
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_attrsp_ -- "type" [type parameters]
-
-   return ffestb_decl_attrsp_;	// to lexer
-
-   Handle COMMA (meaning we have attributes), COLONCOLON (meaning we have
-   no attributes but entities), or go to entsp to see about functions or
-   entities.  */
-
-static ffelexHandler
-ffestb_decl_attrsp_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			   ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
-			   ffestb_local_.decl.len, ffestb_local_.decl.lent);
-      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);
-      return (ffelexHandler) ffestb_decl_attrs_;
-
-    case FFELEX_typeCOLONCOLON:
-      ffestb_local_.decl.coloncolon = TRUE;
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			   ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
-			   ffestb_local_.decl.len, ffestb_local_.decl.lent);
-      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);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    default:
-      return (ffelexHandler) ffestb_decl_entsp_ (t);
-    }
-}
-
-/* ffestb_decl_ents_ -- "type" [type parameters] [attributes "::"]
-
-   return ffestb_decl_ents_;  // to lexer
-
-   Handle NAME of an entity.  */
-
-static ffelexHandler
-ffestb_decl_ents_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_ents_1_;
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_1_ -- "type" [type parameters] [attributes "::"] NAME
-
-   return ffestb_decl_ents_1_;	// to lexer
-
-   Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON.	 */
-
-static ffelexHandler
-ffestb_decl_ents_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
-			  NULL, FALSE);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_item (ffesta_tokens[1], NULL, NULL, NULL, NULL, NULL, NULL,
-			    NULL, FALSE);
-	  ffestc_decl_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeASTERISK:
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      return (ffelexHandler) ffestb_decl_ents_2_;
-
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      return (ffelexHandler) ffestb_decl_ents_3_ (t);
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typeSLASH:
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_subrargs_.dim_list.dims = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      return (ffelexHandler) ffestb_decl_ents_7_ (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_ents_2_ -- "type" [type parameters] [attributes "::"] NAME
-			 ASTERISK
-
-   return ffestb_decl_ents_2_;	// to lexer
-
-   Handle NUMBER or OPEN_PAREN.	 */
-
-static ffelexHandler
-ffestb_decl_ents_2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      if (ffestb_local_.decl.type != FFESTP_typeCHARACTER)
-	{
-	  ffestb_local_.decl.kind = NULL;
-	  ffestb_local_.decl.kindt = ffelex_token_use (t);
-	  return (ffelexHandler) ffestb_decl_ents_3_;
-	}
-      /* Fall through. *//* (CHARACTER's *n is always a len spec. */
-    case FFELEX_typeOPEN_PAREN:/* "*(" is after the (omitted)
-				   "(array-spec)". */
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_subrargs_.dim_list.dims = NULL;
-      return (ffelexHandler) ffestb_decl_ents_5_ (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_ents_3_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER]
-
-   return ffestb_decl_ents_3_;	// to lexer
-
-   Handle ASTERISK, OPEN_PAREN, EQUALS, SLASH, COMMA, or EOS/SEMICOLON.	 */
-
-static ffelexHandler
-ffestb_decl_ents_3_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-	     ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-	     ffestb_local_.decl.kindt, NULL, NULL, NULL, NULL, NULL, FALSE);
-	  ffestc_decl_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeASTERISK:
-      ffestb_subrargs_.dim_list.dims = NULL;
-      return (ffelexHandler) ffestb_decl_ents_5_;
-
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_subrargs_.dim_list.dims = ffestt_dimlist_create ();
-      ffestb_subrargs_.dim_list.handler = (ffelexHandler) ffestb_decl_ents_4_;
-      ffestb_subrargs_.dim_list.pool = ffesta_output_pool;
-      ffestb_subrargs_.dim_list.ctx = ffesta_is_entry_valid
-	? FFEEXPR_contextDIMLIST : FFEEXPR_contextDIMLISTCOMMON;
-#ifdef FFECOM_dimensionsMAX
-      ffestb_subrargs_.dim_list.ndims = 0;
-#endif
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  ffestb_subrargs_.dim_list.ctx,
-				    (ffeexprCallback) ffestb_subr_dimlist_);
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typeSLASH:
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_subrargs_.dim_list.dims = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      return (ffelexHandler) ffestb_decl_ents_7_ (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.decl.kindt != NULL)
-    ffelex_token_kill (ffestb_local_.decl.kindt);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_4_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-
-   return ffestb_decl_ents_4_;	// to lexer
-
-   Handle ASTERISK, EQUALS, SLASH, COMMA, or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_ents_4_ (ffelexToken t)
-{
-  ffelexToken nt;
-
-  if (!ffestb_subrargs_.dim_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  if (ffelex_token_type (ffesta_tokens[1]) == FFELEX_typeNAMES)
-    {
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeCOMMA:
-	case FFELEX_typeEOS:
-	case FFELEX_typeSEMICOLON:
-	case FFELEX_typeASTERISK:
-	case FFELEX_typeSLASH:	/* But NOT FFELEX_typeEQUALS. */
-	case FFELEX_typeCOLONCOLON:	/* Actually an error. */
-	  break;		/* Confirm and handle. */
-
-	default:		/* Perhaps EQUALS, as in
-				   INTEGERFUNCTIONX(A)=B. */
-	  goto bad;		/* :::::::::::::::::::: */
-	}
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	{
-	  nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
-	  ffelex_token_kill (ffesta_tokens[1]);
-	  ffesta_tokens[1] = nt;
-	  ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			     NULL, NULL, NULL, NULL);
-	}
-    }
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
-			  FALSE);
-      ffelex_token_kill (ffesta_tokens[1]);
-      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);
-      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
-			    FALSE);
-	  ffestc_decl_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      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);
-      ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeASTERISK:
-      if (ffestb_local_.decl.lent != NULL)
-	break;			/* Can't specify "*length" twice. */
-      return (ffelexHandler) ffestb_decl_ents_5_;
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typeSLASH:
-      return (ffelexHandler) ffestb_decl_ents_7_ (t);
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
-      && !ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  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);
-  ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_5_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-			 ASTERISK
-
-   return ffestb_decl_ents_5_;	// to lexer
-
-   Handle NUMBER or OPEN_PAREN.	 */
-
-static ffelexHandler
-ffestb_decl_ents_5_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_ents_7_;
-
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-       FFEEXPR_contextCHARACTERSIZE, (ffeexprCallback) ffestb_decl_ents_6_);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.decl.kindt != NULL)
-    ffelex_token_kill (ffestb_local_.decl.kindt);
-  if (ffestb_subrargs_.dim_list.dims != NULL)
-    ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_6_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-			 ASTERISK OPEN_PAREN expr
-
-   (ffestb_decl_ents_6_)  // to expression handler
-
-   Handle CLOSE_PAREN.	*/
-
-static ffelexHandler
-ffestb_decl_ents_6_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      ffestb_local_.decl.len = expr;
-      ffestb_local_.decl.lent = ffelex_token_use (ft);
-      return (ffelexHandler) ffestb_decl_ents_7_;
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.decl.kindt != NULL)
-    ffelex_token_kill (ffestb_local_.decl.kindt);
-  if (ffestb_subrargs_.dim_list.dims != NULL)
-    ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_7_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-			 [ASTERISK charlength]
-
-   return ffestb_decl_ents_7_;	// to lexer
-
-   Handle EQUALS, SLASH, COMMA, or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_ents_7_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
-			  FALSE);
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      if (ffestb_subrargs_.dim_list.dims != NULL)
-	ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      if (ffestb_local_.decl.lent != NULL)
-	ffelex_token_kill (ffestb_local_.decl.lent);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
-			    FALSE);
-	  ffestc_decl_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      if (ffestb_subrargs_.dim_list.dims != NULL)
-	ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      if (ffestb_local_.decl.lent != NULL)
-	ffelex_token_kill (ffestb_local_.decl.lent);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeEQUALS:
-      if (!ffestb_local_.decl.coloncolon)
-	ffesta_ffebad_1t (FFEBAD_INVALID_TYPEDECL_INIT, t);
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		     ffestb_local_.decl.parameter ? FFEEXPR_contextPARAMETER
-	   : FFEEXPR_contextINITVAL, (ffeexprCallback) ffestb_decl_ents_8_);
-
-    case FFELEX_typeSLASH:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		ffestb_local_.decl.len, ffestb_local_.decl.lent, NULL, NULL,
-			    TRUE);
-	  ffestc_decl_itemstartvals ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      if (ffestb_subrargs_.dim_list.dims != NULL)
-	ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      if (ffestb_local_.decl.lent != NULL)
-	ffelex_token_kill (ffestb_local_.decl.lent);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_decl_ents_9_);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.decl.kindt != NULL)
-    ffelex_token_kill (ffestb_local_.decl.kindt);
-  if (ffestb_subrargs_.dim_list.dims != NULL)
-    ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-  if (ffestb_local_.decl.lent != NULL)
-    ffelex_token_kill (ffestb_local_.decl.lent);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_8_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-			 [ASTERISK charlength] EQUALS expr
-
-   (ffestb_decl_ents_8_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_ents_8_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		  ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
-			  FALSE);
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      if (ffestb_subrargs_.dim_list.dims != NULL)
-	ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      if (ffestb_local_.decl.lent != NULL)
-	ffelex_token_kill (ffestb_local_.decl.lent);
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_item (ffesta_tokens[1], ffestb_local_.decl.kind,
-		   ffestb_local_.decl.kindt, ffestb_subrargs_.dim_list.dims,
-		  ffestb_local_.decl.len, ffestb_local_.decl.lent, expr, ft,
-			    FALSE);
-	  ffestc_decl_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      if (ffestb_local_.decl.kindt != NULL)
-	ffelex_token_kill (ffestb_local_.decl.kindt);
-      if (ffestb_subrargs_.dim_list.dims != NULL)
-	ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-      if (ffestb_local_.decl.lent != NULL)
-	ffelex_token_kill (ffestb_local_.decl.lent);
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.decl.kindt != NULL)
-    ffelex_token_kill (ffestb_local_.decl.kindt);
-  if (ffestb_subrargs_.dim_list.dims != NULL)
-    ffestt_dimlist_kill (ffestb_subrargs_.dim_list.dims);
-  if (ffestb_local_.decl.lent != NULL)
-    ffelex_token_kill (ffestb_local_.decl.lent);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_9_ -- "type" ... SLASH expr
-
-   (ffestb_decl_ents_9_)  // to expression handler
-
-   Handle ASTERISK, COMMA, or SLASH.  */
-
-static ffelexHandler
-ffestb_decl_ents_9_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_itemvalue (NULL, NULL, expr, ft);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_decl_ents_9_);
-
-    case FFELEX_typeASTERISK:
-      if (expr == NULL)
-	break;
-      ffestb_local_.decl.expr = expr;
-      ffesta_tokens[1] = ffelex_token_use (ft);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_decl_ents_10_);
-
-    case FFELEX_typeSLASH:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_itemvalue (NULL, NULL, expr, ft);
-	  ffestc_decl_itemendvals (t);
-	}
-      return (ffelexHandler) ffestb_decl_ents_11_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    {
-      ffestc_decl_itemendvals (t);
-      ffestc_decl_finish ();
-    }
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_10_ -- "type" ... SLASH expr ASTERISK expr
-
-   (ffestb_decl_ents_10_)  // to expression handler
-
-   Handle COMMA or SLASH.  */
-
-static ffelexHandler
-ffestb_decl_ents_10_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
-			       expr, ft);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffeexpr_rhs
-	(ffesta_output_pool, FFEEXPR_contextDATA,
-	 (ffeexprCallback) ffestb_decl_ents_9_);
-
-    case FFELEX_typeSLASH:
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_decl_itemvalue (ffestb_local_.decl.expr, ffesta_tokens[1],
-				 expr, ft);
-	  ffestc_decl_itemendvals (t);
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_decl_ents_11_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    {
-      ffestc_decl_itemendvals (t);
-      ffestc_decl_finish ();
-    }
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_ents_11_ -- "type" [type parameters] [attributes "::"] NAME
-			 [ASTERISK NUMBER] [OPEN_PAREN dimlist CLOSE_PAREN]
-			 [ASTERISK charlength] SLASH initvals SLASH
-
-   return ffestb_decl_ents_11_;	 // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_ents_11_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_decl_ents_;
-
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_decl_finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  if (!ffesta_is_inhibited ())
-    ffestc_decl_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_ -- "type" [type parameters]
-
-   return ffestb_decl_entsp_;  // to lexer
-
-   Handle NAME or NAMES beginning either an entity (object) declaration or
-   a function definition..  */
-
-static ffelexHandler
-ffestb_decl_entsp_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_confirmed ();
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_entsp_1_;
-
-    case FFELEX_typeNAMES:
-      ffesta_confirmed ();
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_entsp_2_;
-
-    default:
-      break;
-    }
-
-  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, "type-declaration", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_1_ -- "type" [type parameters] NAME
-
-   return ffestb_decl_entsp_1_;	 // to lexer
-
-   If we get another NAME token here, then the previous one must be
-   "RECURSIVE" or "FUNCTION" and we handle it accordingly.  Otherwise,
-   we send the previous and current token through to _ents_.  */
-
-static ffelexHandler
-ffestb_decl_entsp_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      switch (ffestr_first (ffesta_tokens[1]))
-	{
-	case FFESTR_firstFUNCTION:
-	  ffelex_token_kill (ffesta_tokens[1]);
-	  return (ffelexHandler) ffestb_decl_funcname_ (t);
-
-	default:
-	  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", ffesta_tokens[1]);
-	  break;
-	}
-      break;
-
-    default:
-      if ((ffelex_token_type (ffesta_tokens[1]) != FFELEX_typeNAMES)
-	  && !ffesta_is_inhibited ())
-	ffestc_decl_start (ffestb_local_.decl.type, ffesta_tokens[0],
-			   ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
-			   ffestb_local_.decl.len, ffestb_local_.decl.lent);
-      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);
-      /* NAME/NAMES token already in ffesta_tokens[1]. */
-      return (ffelexHandler) ffestb_decl_ents_1_ (t);
-    }
-
-  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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_2_ -- "type" [type parameters] NAMES
-
-   return ffestb_decl_entsp_2_;	 // to lexer
-
-   If we get an ASTERISK or OPEN_PAREN here, then if the previous NAMES
-   begins with "FUNCTION" or "RECURSIVEFUNCTION" and is followed by a
-   first-name-char, we have a possible syntactically ambiguous situation.
-   Otherwise, we have a straightforward situation just as if we went
-   through _entsp_1_ instead of here.  */
-
-static ffelexHandler
-ffestb_decl_entsp_2_ (ffelexToken t)
-{
-  ffelexToken nt;
-  bool asterisk_ok;
-  unsigned const char *p;
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeASTERISK:
-      ffesta_confirmed ();
-      switch (ffestb_local_.decl.type)
-	{
-	case FFESTP_typeINTEGER:
-	case FFESTP_typeREAL:
-	case FFESTP_typeCOMPLEX:
-	case FFESTP_typeLOGICAL:
-	  asterisk_ok = (ffestb_local_.decl.kindt == NULL);
-	  break;
-
-	case FFESTP_typeCHARACTER:
-	  asterisk_ok = (ffestb_local_.decl.lent == NULL);
-	  break;
-
-	case FFESTP_typeBYTE:
-	case FFESTP_typeWORD:
-	default:
-	  asterisk_ok = FALSE;
-	  break;
-	}
-      switch (ffestr_first (ffesta_tokens[1]))
-	{
-	case FFESTR_firstFUNCTION:
-	  if (!asterisk_ok)
-	    break;		/* For our own convenience, treat as non-FN
-				   stmt. */
-	  p = ffelex_token_text (ffesta_tokens[1])
-	    + (i = FFESTR_firstlFUNCTION);
-	  if (!ffesrc_is_name_init (*p))
-	    break;
-	  ffestb_local_.decl.recursive = NULL;
-	  ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
-						  FFESTR_firstlFUNCTION, 0);
-	  return (ffelexHandler) ffestb_decl_entsp_3_;
-
-	default:
-	  break;
-	}
-      break;
-
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_local_.decl.aster_after = FALSE;
-      switch (ffestr_first (ffesta_tokens[1]))
-	{
-	case FFESTR_firstFUNCTION:
-	  p = ffelex_token_text (ffesta_tokens[1])
-	    + (i = FFESTR_firstlFUNCTION);
-	  if (!ffesrc_is_name_init (*p))
-	    break;
-	  ffestb_local_.decl.recursive = NULL;
-	  ffesta_tokens[2] = ffelex_token_name_from_names (ffesta_tokens[1],
-						  FFESTR_firstlFUNCTION, 0);
-	  return (ffelexHandler) ffestb_decl_entsp_5_ (t);
-
-	default:
-	  break;
-	}
-      if ((ffestb_local_.decl.kindt != NULL)
-	  || (ffestb_local_.decl.lent != NULL))
-	break;			/* Have kind/len type param, definitely not
-				   assignment stmt. */
-      return (ffelexHandler) ffestb_decl_entsp_1_ (t);
-
-    default:
-      break;
-    }
-
-  nt = ffelex_token_name_from_names (ffesta_tokens[1], 0, 0);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffesta_tokens[1] = nt;	/* Change NAMES to NAME. */
-  return (ffelexHandler) ffestb_decl_entsp_1_ (t);
-}
-
-/* ffestb_decl_entsp_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME ASTERISK
-
-   return ffestb_decl_entsp_3_;	 // to lexer
-
-   Handle NUMBER or OPEN_PAREN.	 */
-
-static ffelexHandler
-ffestb_decl_entsp_3_ (ffelexToken t)
-{
-  ffestb_local_.decl.aster_after = TRUE;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      switch (ffestb_local_.decl.type)
-	{
-	case FFESTP_typeINTEGER:
-	case FFESTP_typeREAL:
-	case FFESTP_typeCOMPLEX:
-	case FFESTP_typeLOGICAL:
-	  ffestb_local_.decl.kindt = ffelex_token_use (t);
-	  break;
-
-	case FFESTP_typeCHARACTER:
-	  ffestb_local_.decl.lent = ffelex_token_use (t);
-	  break;
-
-	case FFESTP_typeBYTE:
-	case FFESTP_typeWORD:
-	default:
-	  assert (FALSE);
-	}
-      return (ffelexHandler) ffestb_decl_entsp_5_;
-
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  FFEEXPR_contextCHARACTERSIZE,
-				    (ffeexprCallback) ffestb_decl_entsp_4_);
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME ASTERISK OPEN_PAREN expr
-
-   (ffestb_decl_entsp_4_)  // to expression handler
-
-   Allow only CLOSE_PAREN; and deal with character-length expression.  */
-
-static ffelexHandler
-ffestb_decl_entsp_4_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      switch (ffestb_local_.decl.type)
-	{
-	case FFESTP_typeCHARACTER:
-	  ffestb_local_.decl.len = expr;
-	  ffestb_local_.decl.lent = ffelex_token_use (ft);
-	  break;
-
-	default:
-	  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-	  break;
-	}
-      return (ffelexHandler) ffestb_decl_entsp_5_;
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_entsp_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter]
-
-   return ffestb_decl_entsp_5_;	 // to lexer
-
-   Make sure the next token is an OPEN_PAREN.  Get the arg list or dimension
-   list.  If it can't be an arg list, or if the CLOSE_PAREN is followed by
-   something other than EOS/SEMICOLON or NAME, then treat as dimension list
-   and handle statement as an R426/R501.  If it can't be a dimension list, or
-   if the CLOSE_PAREN is followed by NAME, treat as an arg list and handle
-   statement as an R1219.  If it can be either an arg list or a dimension
-   list and if the CLOSE_PAREN is followed by EOS/SEMICOLON, ask FFESTC
-   whether to treat the statement as an R426/R501 or an R1219 and act
-   accordingly.	 */
-
-static ffelexHandler
-ffestb_decl_entsp_5_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      if (ffestb_local_.decl.aster_after && (ffestb_local_.decl.len != NULL))
-	{			/* "CHARACTER[RECURSIVE]FUNCTIONxyz*(len-expr)
-				   (..." must be a function-stmt, since the
-				   (len-expr) cannot precede (array-spec) in
-				   an object declaration but can precede
-				   (name-list) in a function stmt. */
-	  ffelex_token_kill (ffesta_tokens[1]);
-	  ffesta_tokens[1] = ffesta_tokens[2];
-	  return (ffelexHandler) ffestb_decl_funcname_4_ (t);
-	}
-      ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
-      ffestb_local_.decl.empty = TRUE;
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_entsp_6_;
-
-    default:
-      break;
-    }
-
-  assert (ffestb_local_.decl.aster_after);
-  ffesta_confirmed ();		/* We've seen an ASTERISK, so even EQUALS
-				   confirmed. */
-  ffestb_subr_ambig_to_ents_ ();
-  ffestb_subrargs_.dim_list.dims = NULL;
-  return (ffelexHandler) ffestb_decl_ents_7_ (t);
-}
-
-/* ffestb_decl_entsp_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN
-
-   return ffestb_decl_entsp_6_;	 // to lexer
-
-   If CLOSE_PAREN, we definitely have an R1219 function-stmt, since
-   the notation "name()" is invalid for a declaration.	*/
-
-static ffelexHandler
-ffestb_decl_entsp_6_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (!ffestb_local_.decl.empty)
-	{			/* Trailing comma, just a warning for
-				   stmt func def, so allow ambiguity. */
-	  ffestt_tokenlist_append (ffestb_local_.decl.toklist,
-				   ffelex_token_use (t));
-	  return (ffelexHandler) ffestb_decl_entsp_8_;
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffesta_tokens[1] = ffesta_tokens[2];
-      next = (ffelexHandler) ffestt_tokenlist_handle
-	(ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
-      ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-      return (ffelexHandler) (*next) (t);
-
-    case FFELEX_typeNAME:
-      ffestb_local_.decl.empty = FALSE;
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_entsp_7_;
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-    case FFELEX_typePERCENT:
-    case FFELEX_typePERIOD:
-    case FFELEX_typeOPEN_PAREN:
-      if ((ffestb_local_.decl.kindt != NULL)
-	  || (ffestb_local_.decl.lent != NULL))
-	break;			/* type(params)name or type*val name, either
-				   way confirmed. */
-      return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
-
-    default:
-      break;
-    }
-
-  ffesta_confirmed ();
-  ffestb_subr_ambig_to_ents_ ();
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-				       (ffelexHandler) ffestb_decl_ents_3_);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_entsp_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN NAME
-
-   return ffestb_decl_entsp_7_;	 // to lexer
-
-   Expect COMMA or CLOSE_PAREN to remain ambiguous, else not an R1219
-   function-stmt.  */
-
-static ffelexHandler
-ffestb_decl_entsp_7_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_entsp_8_;
-
-    case FFELEX_typeCOMMA:
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_entsp_6_;
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-    case FFELEX_typePERCENT:
-    case FFELEX_typePERIOD:
-    case FFELEX_typeOPEN_PAREN:
-      if ((ffestb_local_.decl.kindt != NULL)
-	  || (ffestb_local_.decl.lent != NULL))
-	break;			/* type(params)name or type*val name, either
-				   way confirmed. */
-      return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
-
-    default:
-      break;
-    }
-
-  ffesta_confirmed ();
-  ffestb_subr_ambig_to_ents_ ();
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-				       (ffelexHandler) ffestb_decl_ents_3_);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_entsp_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN name-list
-			     CLOSE_PAREN
-
-   return ffestb_decl_entsp_8_;	 // to lexer
-
-   If EOS/SEMICOLON, situation remains ambiguous, ask FFESTC to resolve
-   it.	If NAME (must be "RESULT", but that is checked later on),
-   definitely an R1219 function-stmt.  Anything else, handle as entity decl.  */
-
-static ffelexHandler
-ffestb_decl_entsp_8_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (ffestc_is_decl_not_R1219 ())
-	break;
-      /* Fall through. */
-    case FFELEX_typeNAME:
-      ffesta_confirmed ();
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffesta_tokens[1] = ffesta_tokens[2];
-      next = (ffelexHandler) ffestt_tokenlist_handle
-	(ffestb_local_.decl.toklist, (ffelexHandler) ffestb_decl_funcname_4_);
-      ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-      return (ffelexHandler) (*next) (t);
-
-    case FFELEX_typeEQUALS:
-    case FFELEX_typePOINTS:
-    case FFELEX_typePERCENT:
-    case FFELEX_typePERIOD:
-    case FFELEX_typeOPEN_PAREN:
-      if ((ffestb_local_.decl.kindt != NULL)
-	  || (ffestb_local_.decl.lent != NULL))
-	break;			/* type(params)name or type*val name, either
-				   way confirmed. */
-      return (ffelexHandler) ffestb_subr_ambig_nope_ (t);
-
-    default:
-      break;
-    }
-
-  ffesta_confirmed ();
-  ffestb_subr_ambig_to_ents_ ();
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-				       (ffelexHandler) ffestb_decl_ents_3_);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_funcname_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-
-   return ffestb_decl_funcname_;  // to lexer
-
-   Handle NAME of a function.  */
-
-static ffelexHandler
-ffestb_decl_funcname_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      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);
-}
-
-/* ffestb_decl_funcname_1_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME
-
-   return ffestb_decl_funcname_1_;  // to lexer
-
-   Handle ASTERISK or OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_funcname_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeASTERISK:
-      return (ffelexHandler) ffestb_decl_funcname_2_;
-
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffestb_decl_funcname_4_ (t);
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_2_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME ASTERISK
-
-   return ffestb_decl_funcname_2_;  // to lexer
-
-   Handle NUMBER or OPEN_PAREN.	 */
-
-static ffelexHandler
-ffestb_decl_funcname_2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNUMBER:
-      switch (ffestb_local_.decl.type)
-	{
-	case FFESTP_typeINTEGER:
-	case FFESTP_typeREAL:
-	case FFESTP_typeCOMPLEX:
-	case FFESTP_typeLOGICAL:
-	  if (ffestb_local_.decl.kindt == NULL)
-	    ffestb_local_.decl.kindt = ffelex_token_use (t);
-	  else
-	    ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-	  break;
-
-	case FFESTP_typeCHARACTER:
-	  if (ffestb_local_.decl.lent == NULL)
-	    ffestb_local_.decl.lent = ffelex_token_use (t);
-	  else
-	    ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-	  break;
-
-	case FFESTP_typeBYTE:
-	case FFESTP_typeWORD:
-	default:
-	  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-	  break;
-	}
-      return (ffelexHandler) ffestb_decl_funcname_4_;
-
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-					  FFEEXPR_contextCHARACTERSIZE,
-				 (ffeexprCallback) ffestb_decl_funcname_3_);
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_3_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME ASTERISK OPEN_PAREN expr
-
-   (ffestb_decl_funcname_3_)  // to expression handler
-
-   Allow only CLOSE_PAREN; and deal with character-length expression.  */
-
-static ffelexHandler
-ffestb_decl_funcname_3_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      if (expr == NULL)
-	break;
-      switch (ffestb_local_.decl.type)
-	{
-	case FFESTP_typeCHARACTER:
-	  if (ffestb_local_.decl.lent == NULL)
-	    {
-	      ffestb_local_.decl.len = expr;
-	      ffestb_local_.decl.lent = ffelex_token_use (ft);
-	    }
-	  else
-	    ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-	  break;
-
-	default:
-	  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-	  break;
-	}
-      return (ffelexHandler) ffestb_decl_funcname_4_;
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_4_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter]
-
-   return ffestb_decl_funcname_4_;  // to lexer
-
-   Make sure the next token is an OPEN_PAREN.  Get the arg list and
-   then implement.  */
-
-static ffelexHandler
-ffestb_decl_funcname_4_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_subrargs_.name_list.args = ffestt_tokenlist_create ();
-      ffestb_subrargs_.name_list.handler
-	= (ffelexHandler) ffestb_decl_funcname_5_;
-      ffestb_subrargs_.name_list.is_subr = FALSE;
-      ffestb_subrargs_.name_list.names = FALSE;
-      return (ffelexHandler) ffestb_subr_name_list_;
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_5_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN arg-list
-			     CLOSE_PAREN
-
-   return ffestb_decl_funcname_5_;  // to lexer
-
-   Must have EOS/SEMICOLON or "RESULT" here.  */
-
-static ffelexHandler
-ffestb_decl_funcname_5_ (ffelexToken t)
-{
-  if (!ffestb_subrargs_.name_list.ok)
-    goto bad;			/* :::::::::::::::::::: */
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
-	    ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
-		      ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
-		      ffestb_local_.decl.len, ffestb_local_.decl.lent,
-		      ffestb_local_.decl.recursive, NULL);
-      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);
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-      ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeNAME:
-      if (ffestr_other (t) != FFESTR_otherRESULT)
-	break;
-      return (ffelexHandler) ffestb_decl_funcname_6_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_6_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN arglist
-			     CLOSE_PAREN "RESULT"
-
-   return ffestb_decl_funcname_6_;  // to lexer
-
-   Make sure the next token is an OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_funcname_6_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      return (ffelexHandler) ffestb_decl_funcname_7_;
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_7_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN arglist
-			     CLOSE_PAREN "RESULT" OPEN_PAREN
-
-   return ffestb_decl_funcname_7_;  // to lexer
-
-   Make sure the next token is a NAME.	*/
-
-static ffelexHandler
-ffestb_decl_funcname_7_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[2] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_funcname_8_;
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_8_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN arglist
-			     CLOSE_PAREN "RESULT" OPEN_PAREN NAME
-
-   return ffestb_decl_funcname_8_;  // to lexer
-
-   Make sure the next token is a CLOSE_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_funcname_8_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_decl_funcname_9_;
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_funcname_9_ -- "type" [type parameters] [RECURSIVE] FUNCTION
-			     NAME [type parameter] OPEN_PAREN arg-list
-			     CLOSE_PAREN "RESULT" OPEN_PAREN NAME CLOSE_PAREN
-
-   return ffestb_decl_funcname_9_;  // to lexer
-
-   Must have EOS/SEMICOLON here.  */
-
-static ffelexHandler
-ffestb_decl_funcname_9_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffesta_is_inhibited ())
-	ffestc_R1219 (ffesta_tokens[1], ffestb_subrargs_.name_list.args,
-	    ffestb_subrargs_.name_list.close_paren, ffestb_local_.decl.type,
-		      ffestb_local_.decl.kind, ffestb_local_.decl.kindt,
-		      ffestb_local_.decl.len, ffestb_local_.decl.lent,
-		      ffestb_local_.decl.recursive, ffesta_tokens[2]);
-      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);
-      ffelex_token_kill (ffesta_tokens[1]);
-      ffelex_token_kill (ffesta_tokens[2]);
-      ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-      ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-      return (ffelexHandler) ffesta_zero (t);
-
-    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);
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffelex_token_kill (ffesta_tokens[2]);
-  ffelex_token_kill (ffestb_subrargs_.name_list.close_paren);
-  ffestt_tokenlist_kill (ffestb_subrargs_.name_list.args);
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "FUNCTION", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-/* ffestb_V027 -- Parse the VXT PARAMETER statement
-
-   return ffestb_V027;	// to lexer
-
-   Make sure the statement has a valid form for the VXT PARAMETER statement.
-   If it does, implement the statement.	 */
-
-ffelexHandler
-ffestb_V027 (ffelexToken t)
-{
-  unsigned const char *p;
-  ffeTokenLength i;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstPARAMETER)
-	goto bad_0;		/* :::::::::::::::::::: */
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeNAME:
-	  break;
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-      ffesta_confirmed ();
-      ffestb_local_.vxtparam.started = TRUE;
-      if (!ffesta_is_inhibited ())
-	ffestc_V027_start ();
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_V0271_;
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstPARAMETER)
-	goto bad_0;		/* :::::::::::::::::::: */
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlPARAMETER);
-      switch (ffelex_token_type (t))
-	{
-	case FFELEX_typeEQUALS:
-	  break;
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-      if (!ffesrc_is_name_init (*p))
-	goto bad_i;		/* :::::::::::::::::::: */
-      ffestb_local_.vxtparam.started = FALSE;
-      ffesta_tokens[1] = ffelex_token_name_from_names (ffesta_tokens[0], i,
-						       0);
-      return (ffelexHandler) ffestb_V0271_ (t);
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-
-bad_i:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1sp (FFEBAD_INVALID_STMT_FORM, "PARAMETER", ffesta_tokens[0], i, t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0271_ -- "PARAMETER" NAME
-
-   return ffestb_V0271_;  // to lexer
-
-   Handle EQUALS.  */
-
-static ffelexHandler
-ffestb_V0271_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEQUALS:
-      return (ffelexHandler) ffeexpr_rhs (ffesta_output_pool,
-		 FFEEXPR_contextPARAMETER, (ffeexprCallback) ffestb_V0272_);
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
-    ffestc_V027_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0272_ -- "PARAMETER" NAME EQUALS expr
-
-   (ffestb_V0272_)  // to expression handler
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_V0272_ (ffelexToken ft, ffebld expr, ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffestb_local_.vxtparam.started)
-	{
-	  if (ffestc_is_let_not_V027 ())
-	    break;		/* Not a valid VXTPARAMETER stmt. */
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_V027_start ();
-	  ffestb_local_.vxtparam.started = TRUE;
-	}
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	{
-	  ffestc_V027_item (ffesta_tokens[1], expr, ft);
-	  ffestc_V027_finish ();
-	}
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeCOMMA:
-      ffesta_confirmed ();
-      if (!ffestb_local_.vxtparam.started)
-	{
-	  if (!ffesta_is_inhibited ())
-	    ffestc_V027_start ();
-	  ffestb_local_.vxtparam.started = TRUE;
-	}
-      if (expr == NULL)
-	break;
-      if (!ffesta_is_inhibited ())
-	ffestc_V027_item (ffesta_tokens[1], expr, ft);
-      ffelex_token_kill (ffesta_tokens[1]);
-      return (ffelexHandler) ffestb_V0273_;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
-    ffestc_V027_finish ();
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_V0273_ -- "PARAMETER" NAME EQUALS expr COMMA
-
-   return ffestb_V0273_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_V0273_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_V0271_;
-
-    default:
-      ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "PARAMETER", t);
-      break;
-    }
-
-  if (ffestb_local_.vxtparam.started && !ffesta_is_inhibited ())
-    ffestc_V027_finish ();
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R539 -- Parse the IMPLICIT FUNCTION statement
-
-   return ffestb_decl_R539;  // to lexer
-
-   Make sure the statement has a valid form for the IMPLICIT
-   statement.  If it does, implement the statement.  */
-
-ffelexHandler
-ffestb_decl_R539 (ffelexToken t)
-{
-  ffeTokenLength i;
-  unsigned const char *p;
-  ffelexToken nt;
-  ffestrSecond kw;
-
-  ffestb_local_.decl.recursive = NULL;
-
-  switch (ffelex_token_type (ffesta_tokens[0]))
-    {
-    case FFELEX_typeNAME:
-      if (ffesta_first_kw != FFESTR_firstIMPLICIT)
-	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.imp_started = FALSE;
-      switch (ffesta_second_kw)
-	{
-	case FFESTR_secondINTEGER:
-	  ffestb_local_.decl.type = FFESTP_typeINTEGER;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondBYTE:
-	  ffestb_local_.decl.type = FFESTP_typeBYTE;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondWORD:
-	  ffestb_local_.decl.type = FFESTP_typeWORD;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondREAL:
-	  ffestb_local_.decl.type = FFESTP_typeREAL;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondCOMPLEX:
-	  ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondLOGICAL:
-	  ffestb_local_.decl.type = FFESTP_typeLOGICAL;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondCHARACTER:
-	  ffestb_local_.decl.type = FFESTP_typeCHARACTER;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondDOUBLE:
-	  return (ffelexHandler) ffestb_decl_R5392_;
-
-	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_R539letters_;
-
-	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_R539letters_;
-
-	case FFESTR_secondNONE:
-	  return (ffelexHandler) ffestb_decl_R5394_;
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-    case FFELEX_typeNAMES:
-      if (ffesta_first_kw != FFESTR_firstIMPLICIT)
-	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;
-
-	case FFELEX_typeOPEN_PAREN:
-	  break;
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-      p = ffelex_token_text (ffesta_tokens[0]) + (i = FFESTR_firstlIMPLICIT);
-      if (!ffesrc_is_name_init (*p))
-	goto bad_0;		/* :::::::::::::::::::: */
-      ffestb_local_.decl.imp_started = FALSE;
-      nt = ffelex_token_name_from_names (ffesta_tokens[0],
-					 FFESTR_firstlIMPLICIT, 0);
-      kw = ffestr_second (nt);
-      ffelex_token_kill (nt);
-      switch (kw)
-	{
-	case FFESTR_secondINTEGER:
-	  ffestb_local_.decl.type = FFESTP_typeINTEGER;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	case FFESTR_secondBYTE:
-	  ffestb_local_.decl.type = FFESTP_typeBYTE;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	case FFESTR_secondWORD:
-	  ffestb_local_.decl.type = FFESTP_typeWORD;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	case FFESTR_secondREAL:
-	  ffestb_local_.decl.type = FFESTP_typeREAL;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	case FFESTR_secondCOMPLEX:
-	  ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	case FFESTR_secondLOGICAL:
-	  ffestb_local_.decl.type = FFESTP_typeLOGICAL;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	case FFESTR_secondCHARACTER:
-	  ffestb_local_.decl.type = FFESTP_typeCHARACTER;
-	  return (ffelexHandler) ffestb_decl_R5391_ (t);
-
-	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_R539letters_ (t);
-
-	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_R539letters_ (t);
-
-	case FFESTR_secondNONE:
-	  return (ffelexHandler) ffestb_decl_R5394_ (t);
-
-	default:
-	  goto bad_1;		/* :::::::::::::::::::: */
-	}
-
-    default:
-      goto bad_0;		/* :::::::::::::::::::: */
-    }
-
-bad_0:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", ffesta_tokens[0]);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-
-bad_1:				/* :::::::::::::::::::: */
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t,
-						(ffelexHandler) ffesta_zero);	/* Invalid second token. */
-}
-
-/* ffestb_decl_R5391_ -- "IMPLICIT" generic-type
-
-   return ffestb_decl_R5391_;  // to lexer
-
-   Handle ASTERISK or OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_R5391_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeASTERISK:
-      ffesta_confirmed ();
-      ffestb_local_.decl.handler = (ffelexHandler) ffestb_decl_R539letters_;
-      ffestb_local_.decl.badname = "IMPLICIT";
-      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_R539letters_;
-      ffestb_local_.decl.badname = "IMPLICIT";
-      ffestb_local_.decl.kind = NULL;
-      ffestb_local_.decl.kindt = NULL;
-      ffestb_local_.decl.len = NULL;
-      ffestb_local_.decl.lent = NULL;
-      if (ffestb_local_.decl.type == FFESTP_typeCHARACTER)
-	ffestb_local_.decl.imp_handler
-	  = (ffelexHandler) ffestb_decl_typeparams_;
-      else
-	ffestb_local_.decl.imp_handler
-	  = (ffelexHandler) ffestb_decl_kindparam_;
-      return (ffelexHandler) ffestb_decl_R539maybe_ (t);
-
-    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);
-}
-
-/* ffestb_decl_R5392_ -- "IMPLICIT" "DOUBLE"
-
-   return ffestb_decl_R5392_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_decl_R5392_ (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_R539letters_;
-
-    default:
-      break;
-    }
-
-bad:				/* :::::::::::::::::::: */
-  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);
-}
-
-/* ffestb_decl_R5394_ -- "IMPLICIT" "NONE"
-
-   return ffestb_decl_R5394_;  // to lexer
-
-   Handle EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_R5394_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffesta_confirmed ();
-      if (!ffesta_is_inhibited ())
-	ffestc_R539 ();		/* IMPLICIT NONE. */
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffesta_ffebad_1st (FFEBAD_INVALID_STMT_FORM, "IMPLICIT", t);
-  return (ffelexHandler) ffelex_swallow_tokens (t, (ffelexHandler) ffesta_zero);
-}
-
-/* ffestb_decl_R5395_ -- "IMPLICIT" implicit-spec-list COMMA
-
-   return ffestb_decl_R5395_;  // to lexer
-
-   Handle NAME for next type-spec.  */
-
-static ffelexHandler
-ffestb_decl_R5395_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      switch (ffestr_second (t))
-	{
-	case FFESTR_secondINTEGER:
-	  ffestb_local_.decl.type = FFESTP_typeINTEGER;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondBYTE:
-	  ffestb_local_.decl.type = FFESTP_typeBYTE;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondWORD:
-	  ffestb_local_.decl.type = FFESTP_typeWORD;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondREAL:
-	  ffestb_local_.decl.type = FFESTP_typeREAL;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondCOMPLEX:
-	  ffestb_local_.decl.type = FFESTP_typeCOMPLEX;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondLOGICAL:
-	  ffestb_local_.decl.type = FFESTP_typeLOGICAL;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondCHARACTER:
-	  ffestb_local_.decl.type = FFESTP_typeCHARACTER;
-	  return (ffelexHandler) ffestb_decl_R5391_;
-
-	case FFESTR_secondDOUBLE:
-	  return (ffelexHandler) ffestb_decl_R5392_;
-
-	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_R539letters_;
-
-	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_R539letters_;
-
-	default:
-	  break;
-	}
-      break;
-
-    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);
-}
-
-/* ffestb_decl_R539letters_ -- "IMPLICIT" type-spec
-
-   return ffestb_decl_R539letters_;  // to lexer
-
-   Handle OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_R539letters_ (ffelexToken t)
-{
-  ffelex_set_names (FALSE);
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeOPEN_PAREN:
-      ffestb_local_.decl.imps = ffestt_implist_create ();
-      return (ffelexHandler) ffestb_decl_R539letters_1_;
-
-    default:
-      break;
-    }
-
-  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);
-  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);
-}
-
-/* ffestb_decl_R539letters_1_ -- "IMPLICIT" type-spec OPEN_PAREN
-
-   return ffestb_decl_R539letters_1_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_decl_R539letters_1_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (ffelex_token_length (t) != 1)
-	break;
-      ffesta_tokens[1] = ffelex_token_use (t);
-      return (ffelexHandler) ffestb_decl_R539letters_2_;
-
-    default:
-      break;
-    }
-
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  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);
-  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);
-}
-
-/* ffestb_decl_R539letters_2_ -- "IMPLICIT" type-spec OPEN_PAREN NAME
-
-   return ffestb_decl_R539letters_2_;  // to lexer
-
-   Handle COMMA or MINUS.  */
-
-static ffelexHandler
-ffestb_decl_R539letters_2_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
-      return (ffelexHandler) ffestb_decl_R539letters_1_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
-      return (ffelexHandler) ffestb_decl_R539letters_5_;
-
-    case FFELEX_typeMINUS:
-      return (ffelexHandler) ffestb_decl_R539letters_3_;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  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);
-  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);
-}
-
-/* ffestb_decl_R539letters_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
-
-   return ffestb_decl_R539letters_3_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_decl_R539letters_3_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (ffelex_token_length (t) != 1)
-	break;
-      ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
-			     ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539letters_4_;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  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);
-  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);
-}
-
-/* ffestb_decl_R539letters_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
-				 NAME
-
-   return ffestb_decl_R539letters_4_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN.	 */
-
-static ffelexHandler
-ffestb_decl_R539letters_4_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      return (ffelexHandler) ffestb_decl_R539letters_1_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      return (ffelexHandler) ffestb_decl_R539letters_5_;
-
-    default:
-      break;
-    }
-
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  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);
-  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);
-}
-
-/* ffestb_decl_R539letters_5_ -- "IMPLICIT" type-spec OPEN_PAREN
-				 letter-spec-list CLOSE_PAREN
-
-   return ffestb_decl_R539letters_5_;  // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_R539letters_5_ (ffelexToken t)
-{
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      if (!ffestb_local_.decl.imp_started)
-	{
-	  ffestb_local_.decl.imp_started = TRUE;
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R539start ();
-	}
-      if (!ffesta_is_inhibited ())
-	ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
-			 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
-			 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
-      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);
-      ffestt_implist_kill (ffestb_local_.decl.imps);
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_decl_R5395_;
-      if (!ffesta_is_inhibited ())
-	ffestc_R539finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    default:
-      break;
-    }
-
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  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);
-  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);
-}
-
-/* ffestb_decl_R539maybe_ -- "IMPLICIT" generic-type-spec
-
-   return ffestb_decl_R539maybe_;  // to lexer
-
-   Handle OPEN_PAREN.  */
-
-static ffelexHandler
-ffestb_decl_R539maybe_ (ffelexToken t)
-{
-  assert (ffelex_token_type (t) == FFELEX_typeOPEN_PAREN);
-  ffestb_local_.decl.imps = ffestt_implist_create ();
-  ffestb_local_.decl.toklist = ffestt_tokenlist_create ();
-  ffestb_local_.decl.imp_seen_comma
-    = (ffestb_local_.decl.type != FFESTP_typeCHARACTER);
-  return (ffelexHandler) ffestb_decl_R539maybe_1_;
-}
-
-/* ffestb_decl_R539maybe_1_ -- "IMPLICIT" generic-type-spec OPEN_PAREN
-
-   return ffestb_decl_R539maybe_1_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_decl_R539maybe_1_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (ffelex_token_length (t) != 1)
-	break;
-      ffesta_tokens[1] = ffelex_token_use (t);
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_2_;
-
-    default:
-      break;
-    }
-
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-			    (ffelexHandler) ffestb_local_.decl.imp_handler);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_2_ -- "IMPLICIT" generic-type-spec OPEN_PAREN NAME
-
-   return ffestb_decl_R539maybe_2_;  // to lexer
-
-   Handle COMMA or MINUS.  */
-
-static ffelexHandler
-ffestb_decl_R539maybe_2_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
-      if (ffestb_local_.decl.imp_seen_comma)
-	{
-	  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-	  return (ffelexHandler) ffestb_decl_R539letters_1_;
-	}
-      ffestb_local_.decl.imp_seen_comma = TRUE;
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_1_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1], NULL);
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_5_;
-
-    case FFELEX_typeMINUS:
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_3_;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-			    (ffelexHandler) ffestb_local_.decl.imp_handler);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_3_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
-
-   return ffestb_decl_R539maybe_3_;  // to lexer
-
-   Handle NAME.	 */
-
-static ffelexHandler
-ffestb_decl_R539maybe_3_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeNAME:
-      if (ffelex_token_length (t) != 1)
-	break;
-      ffestt_implist_append (ffestb_local_.decl.imps, ffesta_tokens[1],
-			     ffelex_token_use (t));
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_4_;
-
-    default:
-      break;
-    }
-
-  ffelex_token_kill (ffesta_tokens[1]);
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-			    (ffelexHandler) ffestb_local_.decl.imp_handler);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_4_ -- "IMPLICIT" type-spec OPEN_PAREN NAME MINUS
-				 NAME
-
-   return ffestb_decl_R539maybe_4_;  // to lexer
-
-   Handle COMMA or CLOSE_PAREN.	 */
-
-static ffelexHandler
-ffestb_decl_R539maybe_4_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-      if (ffestb_local_.decl.imp_seen_comma)
-	{
-	  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-	  return (ffelexHandler) ffestb_decl_R539letters_1_;
-	}
-      ffestb_local_.decl.imp_seen_comma = TRUE;
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_1_;
-
-    case FFELEX_typeCLOSE_PAREN:
-      ffestt_tokenlist_append (ffestb_local_.decl.toklist, ffelex_token_use (t));
-      return (ffelexHandler) ffestb_decl_R539maybe_5_;
-
-    default:
-      break;
-    }
-
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-			    (ffelexHandler) ffestb_local_.decl.imp_handler);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  return (ffelexHandler) (*next) (t);
-}
-
-/* ffestb_decl_R539maybe_5_ -- "IMPLICIT" type-spec OPEN_PAREN
-				 letter-spec-list CLOSE_PAREN
-
-   return ffestb_decl_R539maybe_5_;  // to lexer
-
-   Handle COMMA or EOS/SEMICOLON.  */
-
-static ffelexHandler
-ffestb_decl_R539maybe_5_ (ffelexToken t)
-{
-  ffelexHandler next;
-
-  switch (ffelex_token_type (t))
-    {
-    case FFELEX_typeCOMMA:
-    case FFELEX_typeEOS:
-    case FFELEX_typeSEMICOLON:
-      ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-      if (!ffestb_local_.decl.imp_started)
-	{
-	  ffestb_local_.decl.imp_started = TRUE;
-	  ffesta_confirmed ();
-	  if (!ffesta_is_inhibited ())
-	    ffestc_R539start ();
-	}
-      if (!ffesta_is_inhibited ())
-	ffestc_R539item (ffestb_local_.decl.type, ffestb_local_.decl.kind,
-			 ffestb_local_.decl.kindt, ffestb_local_.decl.len,
-			 ffestb_local_.decl.lent, ffestb_local_.decl.imps);
-      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);
-      ffestt_implist_kill (ffestb_local_.decl.imps);
-      if (ffelex_token_type (t) == FFELEX_typeCOMMA)
-	return (ffelexHandler) ffestb_decl_R5395_;
-      if (!ffesta_is_inhibited ())
-	ffestc_R539finish ();
-      return (ffelexHandler) ffesta_zero (t);
-
-    case FFELEX_typeOPEN_PAREN:
-      ffesta_confirmed ();
-      ffestt_implist_kill (ffestb_local_.decl.imps);
-      next = (ffelexHandler) ffestt_tokenlist_handle (ffestb_local_.decl.toklist,
-			    (ffelexHandler) ffestb_local_.decl.imp_handler);
-      ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-      return (ffelexHandler) (*next) (t);
-
-    default:
-      break;
-    }
-
-  ffestt_implist_kill (ffestb_local_.decl.imps);
-  ffestt_tokenlist_kill (ffestb_local_.decl.toklist);
-  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);
-  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);
-}
diff --git a/gcc/f/stb.h b/gcc/f/stb.h
deleted file mode 100644
index 88cb7c5..0000000
--- a/gcc/f/stb.h
+++ /dev/null
@@ -1,177 +0,0 @@
-/* stb.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stb.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STB_H
-#define GCC_F_STB_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bad.h"
-#include "expr.h"
-#include "lex.h"
-#include "stp.h"
-#include "str.h"
-
-/* Structure definitions. */
-
-struct _ffestb_args_
-  {
-    struct
-      {
-	const char *badname;
-	ffeTokenLength len;	/* Length of "ENTRY/FUNCTION/SUBROUTINE". */
-	bool is_subr;		/* TRUE if SUBROUTINE or if ENTRY within
-				   SUBROUTINE. */
-      }
-    dummy;
-    struct
-      {
-	const char *badname;
-	ffeTokenLength len;	/* Length of
-				   "BACKSPACE/ENDFILE/REWIND/UNLOCK". */
-      }
-    beru;
-    struct
-      {
-	ffeTokenLength len;	/* Length of keyword including "END". */
-	ffestrSecond second;	/* Second keyword. */
-      }
-    endxyz;
-    struct
-      {
-	ffestrSecond second;	/* Second keyword. */
-      }
-    elsexyz;
-    struct
-      {
-	ffeTokenLength len;	/* Length of "STOP/PAUSE". */
-      }
-    halt;
-    struct
-      {
-	const char *badname;
-	ffeTokenLength len;	/* Length of
-				   "EXTERNAL/INTENT/INTRINSIC/OPTIONAL/PUBLIC/
-				   PRIVATE". */
-      }
-    varlist;
-    struct
-      {
-	const char *badname;
-	ffeTokenLength len;	/* Length of "DIMENSION/VIRTUAL". */
-      }
-    R524;
-    struct
-      {
-	ffeTokenLength len;	/* Length of first keyword. */
-	ffestpType type;	/* Type of declaration. */
-      }
-    decl;
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern struct _ffestb_args_ ffestb_args;
-
-/* Declare functions with prototypes. */
-
-ffelexHandler ffestb_beru (ffelexToken t);
-ffelexHandler ffestb_block (ffelexToken t);
-ffelexHandler ffestb_blockdata (ffelexToken t);
-ffelexHandler ffestb_decl_chartype (ffelexToken t);
-ffelexHandler ffestb_construct (ffelexToken t);
-ffelexHandler ffestb_decl_dbltype (ffelexToken t);
-ffelexHandler ffestb_decl_double (ffelexToken t);
-ffelexHandler ffestb_dimlist (ffelexToken t);
-ffelexHandler ffestb_do (ffelexToken t);
-ffelexHandler ffestb_dowhile (ffelexToken t);
-ffelexHandler ffestb_dummy (ffelexToken t);
-ffelexHandler ffestb_else (ffelexToken t);
-ffelexHandler ffestb_elsexyz (ffelexToken t);
-ffelexHandler ffestb_end (ffelexToken t);
-ffelexHandler ffestb_endxyz (ffelexToken t);
-ffelexHandler ffestb_decl_gentype (ffelexToken t);
-ffelexHandler ffestb_goto (ffelexToken t);
-ffelexHandler ffestb_halt (ffelexToken t);
-ffelexHandler ffestb_if (ffelexToken t);
-ffelexHandler ffestb_let (ffelexToken t);
-ffelexHandler ffestb_varlist (ffelexToken t);
-ffelexHandler ffestb_R522 (ffelexToken t);
-ffelexHandler ffestb_R524 (ffelexToken t);
-ffelexHandler ffestb_R528 (ffelexToken t);
-ffelexHandler ffestb_R537 (ffelexToken t);
-ffelexHandler ffestb_decl_R539 (ffelexToken t);
-ffelexHandler ffestb_R542 (ffelexToken t);
-ffelexHandler ffestb_R544 (ffelexToken t);
-ffelexHandler ffestb_R547 (ffelexToken t);
-ffelexHandler ffestb_R809 (ffelexToken t);
-ffelexHandler ffestb_R810 (ffelexToken t);
-ffelexHandler ffestb_R834 (ffelexToken t);
-ffelexHandler ffestb_R835 (ffelexToken t);
-ffelexHandler ffestb_R838 (ffelexToken t);
-ffelexHandler ffestb_R840 (ffelexToken t);
-ffelexHandler ffestb_R841 (ffelexToken t);
-ffelexHandler ffestb_R904 (ffelexToken t);
-ffelexHandler ffestb_R907 (ffelexToken t);
-ffelexHandler ffestb_R909 (ffelexToken t);
-ffelexHandler ffestb_R910 (ffelexToken t);
-ffelexHandler ffestb_R911 (ffelexToken t);
-ffelexHandler ffestb_R923 (ffelexToken t);
-ffelexHandler ffestb_R1001 (ffelexToken t);
-ffelexHandler ffestb_R1102 (ffelexToken t);
-ffelexHandler ffestb_R1212 (ffelexToken t);
-ffelexHandler ffestb_R1227 (ffelexToken t);
-ffelexHandler ffestb_R1229 (ffelexToken t);
-ffelexHandler ffestb_S3P4 (ffelexToken t);
-ffelexHandler ffestb_V014 (ffelexToken t);
-ffelexHandler ffestb_V020 (ffelexToken t);
-ffelexHandler ffestb_V027 (ffelexToken t);
-
-/* Define macros. */
-
-#define ffestb_init_0()
-#define ffestb_init_1()
-#define ffestb_init_2()
-#define ffestb_init_3()
-#define ffestb_init_4()
-#define ffestb_terminate_0()
-#define ffestb_terminate_1()
-#define ffestb_terminate_2()
-#define ffestb_terminate_3()
-#define ffestb_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STB_H */
diff --git a/gcc/f/stc.c b/gcc/f/stc.c
deleted file mode 100644
index 5f05813..0000000
--- a/gcc/f/stc.c
+++ /dev/null
@@ -1,10459 +0,0 @@
-/* stc.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      st.c
-
-   Description:
-      Verifies the proper semantics for statements, checking expressions already
-      semantically analyzed individually, collectively, checking label defs and
-      refs, and so on.	Uses ffebad to indicate errors in semantics.
-
-      In many cases, both a token and a keyword (ffestrFirst, ffestrSecond,
-      or ffestrOther) is provided.  ONLY USE THE TOKEN as a pointer to the
-      source-code location for an error message or similar; use the keyword
-      as the semantic matching for the token, since the token's text might
-      not match the keyword's code.  For example, INTENT(IN OUT) A in free
-      source form passes to ffestc_R519_start the token "IN" but the keyword
-      FFESTR_otherINOUT, and the latter is correct.
-
-      Generally, either a single ffestc function handles an entire statement,
-      in which case its name is ffestc_xyz_, or more than one function is
-      needed, in which case its names are ffestc_xyz_start_,
-      ffestc_xyz_item_ or ffestc_xyz_item_abc_, and ffestc_xyz_finish_.
-      The caller must call _start_ before calling any _item_ functions, and
-      must call _finish_ afterwards.  If it is clearly a syntactic matter as
-      to restrictions on the number and variety of _item_ calls, then the caller
-      should report any errors and ffestc_ should presume it has been taken
-      care of and handle any semantic problems with grace and no error messages.
-      If the permitted number and variety of _item_ calls has some basis in
-      semantics, then the caller should not generate any messages and ffestc
-      should do all the checking.
-
-      A few ffestc functions have names rather than grammar numbers, like
-      ffestc_elsewhere and ffestc_end.	These are cases where the actual
-      statement depends on its context rather than just its form; ELSE WHERE
-      may be the obvious (WHERE...ELSE WHERE...END WHERE) or something a little
-      more subtle (WHERE: IF THEN...ELSE WHERE...END IF WHERE).	 The actual
-      ffestc functions do exist and do work, but may or may not be invoked
-      by ffestb depending on whether some form of resolution is possible.
-      For example, ffestc_R1103 end-program-stmt is reachable directly when
-      END PROGRAM [name] is specified, or via ffestc_end when END is specified
-      and the context is a main program.  So ffestc_xyz_ should make a quick
-      determination of the context and pick the appropriate ffestc_Nxyz_
-      function to invoke, without a lot of ceremony.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stc.h"
-#include "bad.h"
-#include "bld.h"
-#include "data.h"
-#include "expr.h"
-#include "global.h"
-#include "implic.h"
-#include "lex.h"
-#include "malloc.h"
-#include "src.h"
-#include "sta.h"
-#include "std.h"
-#include "stp.h"
-#include "str.h"
-#include "stt.h"
-#include "stw.h"
-
-/* Externals defined here. */
-
-ffeexprContext ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
-/* Valid only from READ/WRITE start to finish. */
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFESTC_orderOK_,		/* Statement ok in this context, process. */
-    FFESTC_orderBAD_,		/* Statement not ok in this context, don't
-				   process. */
-    FFESTC_orderBADOK_,		/* Don't process but push block if
-				   applicable. */
-    FFESTC
-  } ffestcOrder_;
-
-typedef enum
-  {
-    FFESTC_stateletSIMPLE_,	/* Expecting simple/start. */
-    FFESTC_stateletATTRIB_,	/* Expecting attrib/item/itemstart. */
-    FFESTC_stateletITEM_,	/* Expecting item/itemstart/finish. */
-    FFESTC_stateletITEMVALS_,	/* Expecting itemvalue/itemendvals. */
-    FFESTC_
-  } ffestcStatelet_;
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-union ffestc_local_u_
-  {
-    struct
-      {
-	ffebld initlist;	/* For list of one sym in INTEGER I/3/ case. */
-	ffetargetCharacterSize stmt_size;
-	ffetargetCharacterSize size;
-	ffeinfoBasictype basic_type;
-	ffeinfoKindtype stmt_kind_type;
-	ffeinfoKindtype kind_type;
-	bool per_var_kind_ok;
-	char is_R426;		/* 1=R426, 2=R501. */
-      }
-    decl;
-    struct
-      {
-	ffebld objlist;		/* For list of target objects. */
-	ffebldListBottom list_bottom;	/* For building lists. */
-      }
-    data;
-    struct
-      {
-	ffebldListBottom list_bottom;	/* For building lists. */
-	int entry_num;
-      }
-    dummy;
-    struct
-      {
-	ffesymbol symbol;	/* NML symbol. */
-      }
-    namelist;
-    struct
-      {
-	ffelexToken t;		/* First token in list. */
-	ffeequiv eq;		/* Current equivalence being built up. */
-	ffebld list;		/* List of expressions in equivalence. */
-	ffebldListBottom bottom;
-	bool ok;		/* TRUE while current list still being
-				   processed. */
-	bool save;		/* TRUE if any var in list is SAVEd. */
-      }
-    equiv;
-    struct
-      {
-	ffesymbol symbol;	/* BCB/NCB symbol. */
-      }
-    common;
-    struct
-      {
-	ffesymbol symbol;	/* SFN symbol. */
-      }
-    sfunc;
-  };				/* Merge with the one in ffestc later. */
-
-/* Static objects accessed by functions in this module. */
-
-static bool ffestc_ok_;		/* _start_ fn's send this to _xyz_ fn's. */
-static bool ffestc_parent_ok_;	/* Parent sym for baby sym fn's ok. */
-static char ffestc_namelist_;	/* 0=>not namelist, 1=>namelist, 2=>error. */
-static union ffestc_local_u_ ffestc_local_;
-static ffestcStatelet_ ffestc_statelet_ = FFESTC_stateletSIMPLE_;
-static ffestwShriek ffestc_shriek_after1_ = NULL;
-static unsigned long ffestc_blocknum_ = 0;	/* Next block# to assign. */
-static int ffestc_entry_num_;
-static int ffestc_sfdummy_argno_;
-static int ffestc_saved_entry_num_;
-static ffelab ffestc_label_;
-
-/* Static functions (internal). */
-
-static void ffestc_R544_equiv_ (ffebld expr, ffelexToken t);
-static void ffestc_establish_declinfo_ (ffebld kind, ffelexToken kindt,
-					ffebld len, ffelexToken lent);
-static void ffestc_establish_declstmt_ (ffestpType type, ffelexToken typet,
-					ffebld kind, ffelexToken kindt,
-					ffebld len, ffelexToken lent);
-static void ffestc_establish_impletter_ (ffelexToken first, ffelexToken last);
-static ffeinfoKindtype ffestc_kindtype_kind_ (ffeinfoBasictype bt,
-					      ffetargetCharacterSize val);
-static ffeinfoKindtype ffestc_kindtype_star_ (ffeinfoBasictype bt,
-					      ffetargetCharacterSize val);
-static void ffestc_labeldef_any_ (void);
-static bool ffestc_labeldef_begin_ (void);
-static void ffestc_labeldef_branch_begin_ (void);
-static void ffestc_labeldef_branch_end_ (void);
-static void ffestc_labeldef_endif_ (void);
-static void ffestc_labeldef_format_ (void);
-static void ffestc_labeldef_invalid_ (void);
-static void ffestc_labeldef_notloop_ (void);
-static void ffestc_labeldef_notloop_begin_ (void);
-static void ffestc_labeldef_useless_ (void);
-static bool ffestc_labelref_is_assignable_ (ffelexToken label_token,
-					    ffelab *label);
-static bool ffestc_labelref_is_branch_ (ffelexToken label_token,
-					ffelab *label);
-static bool ffestc_labelref_is_format_ (ffelexToken label_token,
-					ffelab *label);
-static bool ffestc_labelref_is_loopend_ (ffelexToken label_token,
-					 ffelab *label);
-static ffestcOrder_ ffestc_order_actiondo_ (void);
-static ffestcOrder_ ffestc_order_actionif_ (void);
-static ffestcOrder_ ffestc_order_actionwhere_ (void);
-static void ffestc_order_any_ (void);
-static void ffestc_order_bad_ (void);
-static ffestcOrder_ ffestc_order_blockdata_ (void);
-static ffestcOrder_ ffestc_order_blockspec_ (void);
-static ffestcOrder_ ffestc_order_data_ (void);
-static ffestcOrder_ ffestc_order_data77_ (void);
-static ffestcOrder_ ffestc_order_do_ (void);
-static ffestcOrder_ ffestc_order_entry_ (void);
-static ffestcOrder_ ffestc_order_exec_ (void);
-static ffestcOrder_ ffestc_order_format_ (void);
-static ffestcOrder_ ffestc_order_function_ (void);
-static ffestcOrder_ ffestc_order_iface_ (void);
-static ffestcOrder_ ffestc_order_ifthen_ (void);
-static ffestcOrder_ ffestc_order_implicit_ (void);
-static ffestcOrder_ ffestc_order_implicitnone_ (void);
-static ffestcOrder_ ffestc_order_parameter_ (void);
-static ffestcOrder_ ffestc_order_program_ (void);
-static ffestcOrder_ ffestc_order_progspec_ (void);
-static ffestcOrder_ ffestc_order_selectcase_ (void);
-static ffestcOrder_ ffestc_order_sfunc_ (void);
-static ffestcOrder_ ffestc_order_subroutine_ (void);
-static ffestcOrder_ ffestc_order_typedecl_ (void);
-static ffestcOrder_ ffestc_order_unit_ (void);
-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);
-static void ffestc_shriek_blockdata_ (bool ok);
-static void ffestc_shriek_do_ (bool ok);
-static void ffestc_shriek_end_program_ (bool ok);
-static void ffestc_shriek_function_ (bool ok);
-static void ffestc_shriek_if_ (bool ok);
-static void ffestc_shriek_ifthen_ (bool ok);
-static void ffestc_shriek_select_ (bool ok);
-static void ffestc_shriek_subroutine_ (bool ok);
-static int ffestc_subr_binsrch_ (const char *const *list, int size,
-				 ffestpFile *spec, const char *whine);
-static ffestvFormat ffestc_subr_format_ (ffestpFile *spec);
-static bool ffestc_subr_is_branch_ (ffestpFile *spec);
-static bool ffestc_subr_is_format_ (ffestpFile *spec);
-static bool ffestc_subr_is_present_ (const char *name, ffestpFile *spec);
-static int ffestc_subr_speccmp_ (const char *string, ffestpFile *spec,
-				 const char **target, int *length);
-static ffestvUnit ffestc_subr_unit_ (ffestpFile *spec);
-static void ffestc_try_shriek_do_ (void);
-
-/* Internal macros. */
-
-#define ffestc_check_simple_() \
-      assert(ffestc_statelet_ == FFESTC_stateletSIMPLE_)
-#define ffestc_check_start_() \
-      assert(ffestc_statelet_ == FFESTC_stateletSIMPLE_); \
-      ffestc_statelet_ = FFESTC_stateletATTRIB_
-#define ffestc_check_attrib_() \
-      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_)
-#define ffestc_check_item_() \
-      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_	 \
-	    || ffestc_statelet_ == FFESTC_stateletITEM_); \
-      ffestc_statelet_ = FFESTC_stateletITEM_
-#define ffestc_check_item_startvals_() \
-      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_	 \
-	    || ffestc_statelet_ == FFESTC_stateletITEM_); \
-      ffestc_statelet_ = FFESTC_stateletITEMVALS_
-#define ffestc_check_item_value_() \
-      assert(ffestc_statelet_ == FFESTC_stateletITEMVALS_)
-#define ffestc_check_item_endvals_() \
-      assert(ffestc_statelet_ == FFESTC_stateletITEMVALS_); \
-      ffestc_statelet_ = FFESTC_stateletITEM_
-#define ffestc_check_finish_() \
-      assert(ffestc_statelet_ == FFESTC_stateletATTRIB_	 \
-	    || ffestc_statelet_ == FFESTC_stateletITEM_); \
-      ffestc_statelet_ = FFESTC_stateletSIMPLE_
-#define ffestc_order_action_() ffestc_order_exec_()
-#define ffestc_shriek_if_lost_ ffestc_shriek_if_
-
-/* ffestc_establish_declinfo_ -- Determine specific type/params info for entity
-
-   ffestc_establish_declinfo_(kind,kind_token,len,len_token);
-
-   Must be called after _declstmt_ called to establish base type.  */
-
-static void
-ffestc_establish_declinfo_ (ffebld kind, ffelexToken kindt, ffebld len,
-			    ffelexToken lent)
-{
-  ffeinfoBasictype bt = ffestc_local_.decl.basic_type;
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize val;
-
-  if (kindt == NULL)
-    kt = ffestc_local_.decl.stmt_kind_type;
-  else if (!ffestc_local_.decl.per_var_kind_ok)
-    {
-      ffebad_start (FFEBAD_KINDTYPE);
-      ffebad_here (0, ffelex_token_where_line (kindt),
-		   ffelex_token_where_column (kindt));
-      ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-      kt = ffestc_local_.decl.stmt_kind_type;
-    }
-  else
-    {
-      if (kind == NULL)
-	{
-	  assert (ffelex_token_type (kindt) == FFELEX_typeNUMBER);
-	  val = atol (ffelex_token_text (kindt));
-	  kt = ffestc_kindtype_star_ (bt, val);
-	}
-      else if (ffebld_op (kind) == FFEBLD_opANY)
-	kt = ffestc_local_.decl.stmt_kind_type;
-      else
-	{
-	  assert (ffebld_op (kind) == FFEBLD_opCONTER);
-	  assert (ffeinfo_basictype (ffebld_info (kind))
-		  == FFEINFO_basictypeINTEGER);
-	  assert (ffeinfo_kindtype (ffebld_info (kind))
-		  == FFEINFO_kindtypeINTEGERDEFAULT);
-	  val = ffebld_constant_integerdefault (ffebld_conter (kind));
-	  kt = ffestc_kindtype_kind_ (bt, val);
-	}
-
-      if (kt == FFEINFO_kindtypeNONE)
-	{			/* Not valid kind type. */
-	  ffebad_start (FFEBAD_KINDTYPE);
-	  ffebad_here (0, ffelex_token_where_line (kindt),
-		       ffelex_token_where_column (kindt));
-	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_finish ();
-	  kt = ffestc_local_.decl.stmt_kind_type;
-	}
-    }
-
-  ffestc_local_.decl.kind_type = kt;
-
-  /* Now check length specification for CHARACTER data type. */
-
-  if (((len == NULL) && (lent == NULL))
-      || (bt != FFEINFO_basictypeCHARACTER))
-    val = ffestc_local_.decl.stmt_size;
-  else
-    {
-      if (len == NULL)
-	{
-	  assert (ffelex_token_type (lent) == FFELEX_typeNUMBER);
-	  val = atol (ffelex_token_text (lent));
-	}
-      else if (ffebld_op (len) == FFEBLD_opSTAR)
-	val = FFETARGET_charactersizeNONE;
-      else if (ffebld_op (len) == FFEBLD_opANY)
-	val = FFETARGET_charactersizeNONE;
-      else
-	{
-	  assert (ffebld_op (len) == FFEBLD_opCONTER);
-	  assert (ffeinfo_basictype (ffebld_info (len))
-		  == FFEINFO_basictypeINTEGER);
-	  assert (ffeinfo_kindtype (ffebld_info (len))
-		  == FFEINFO_kindtypeINTEGERDEFAULT);
-	  val = ffebld_constant_integerdefault (ffebld_conter (len));
-	}
-    }
-
-  if ((val == 0) && !(0 && ffe_is_90 ()))
-    {
-      val = 1;
-      ffebad_start (FFEBAD_ZERO_SIZE);
-      ffebad_here (0, ffelex_token_where_line (lent), ffelex_token_where_column (lent));
-      ffebad_finish ();
-    }
-  ffestc_local_.decl.size = val;
-}
-
-/* ffestc_establish_declstmt_ -- Establish host-specific type/params info
-
-   ffestc_establish_declstmt_(type,type_token,kind,kind_token,len,
-	 len_token);  */
-
-static void
-ffestc_establish_declstmt_ (ffestpType type, ffelexToken typet, ffebld kind,
-			    ffelexToken kindt, ffebld len, ffelexToken lent)
-{
-  ffeinfoBasictype bt;
-  ffeinfoKindtype ktd;		/* Default kindtype. */
-  ffeinfoKindtype kt;
-  ffetargetCharacterSize val;
-  bool per_var_kind_ok = TRUE;
-
-  /* Determine basictype and default kindtype. */
-
-  switch (type)
-    {
-    case FFESTP_typeINTEGER:
-      bt = FFEINFO_basictypeINTEGER;
-      ktd = FFEINFO_kindtypeINTEGERDEFAULT;
-      break;
-
-    case FFESTP_typeBYTE:
-      bt = FFEINFO_basictypeINTEGER;
-      ktd = FFEINFO_kindtypeINTEGER2;
-      break;
-
-    case FFESTP_typeWORD:
-      bt = FFEINFO_basictypeINTEGER;
-      ktd = FFEINFO_kindtypeINTEGER3;
-      break;
-
-    case FFESTP_typeREAL:
-      bt = FFEINFO_basictypeREAL;
-      ktd = FFEINFO_kindtypeREALDEFAULT;
-      break;
-
-    case FFESTP_typeCOMPLEX:
-      bt = FFEINFO_basictypeCOMPLEX;
-      ktd = FFEINFO_kindtypeREALDEFAULT;
-      break;
-
-    case FFESTP_typeLOGICAL:
-      bt = FFEINFO_basictypeLOGICAL;
-      ktd = FFEINFO_kindtypeLOGICALDEFAULT;
-      break;
-
-    case FFESTP_typeCHARACTER:
-      bt = FFEINFO_basictypeCHARACTER;
-      ktd = FFEINFO_kindtypeCHARACTERDEFAULT;
-      break;
-
-    case FFESTP_typeDBLPRCSN:
-      bt = FFEINFO_basictypeREAL;
-      ktd = FFEINFO_kindtypeREALDOUBLE;
-      per_var_kind_ok = FALSE;
-      break;
-
-    case FFESTP_typeDBLCMPLX:
-      bt = FFEINFO_basictypeCOMPLEX;
-#if FFETARGET_okCOMPLEX2
-      ktd = FFEINFO_kindtypeREALDOUBLE;
-#else
-      ktd = FFEINFO_kindtypeREALDEFAULT;
-      ffebad_start (FFEBAD_BAD_DBLCMPLX);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-#endif
-      per_var_kind_ok = FALSE;
-      break;
-
-    default:
-      assert ("Unexpected type (F90 TYPE?)!" == NULL);
-      bt = FFEINFO_basictypeNONE;
-      ktd = FFEINFO_kindtypeNONE;
-      break;
-    }
-
-  if (kindt == NULL)
-    kt = ktd;
-  else
-    {				/* Not necessarily default kind type. */
-      if (kind == NULL)
-	{			/* Shouldn't happen for CHARACTER. */
-	  assert (ffelex_token_type (kindt) == FFELEX_typeNUMBER);
-	  val = atol (ffelex_token_text (kindt));
-	  kt = ffestc_kindtype_star_ (bt, val);
-	}
-      else if (ffebld_op (kind) == FFEBLD_opANY)
-	kt = ktd;
-      else
-	{
-	  assert (ffebld_op (kind) == FFEBLD_opCONTER);
-	  assert (ffeinfo_basictype (ffebld_info (kind))
-		  == FFEINFO_basictypeINTEGER);
-	  assert (ffeinfo_kindtype (ffebld_info (kind))
-		  == FFEINFO_kindtypeINTEGERDEFAULT);
-	  val = ffebld_constant_integerdefault (ffebld_conter (kind));
-	  kt = ffestc_kindtype_kind_ (bt, val);
-	}
-
-      if (kt == FFEINFO_kindtypeNONE)
-	{			/* Not valid kind type. */
-	  ffebad_start (FFEBAD_KINDTYPE);
-	  ffebad_here (0, ffelex_token_where_line (kindt),
-		       ffelex_token_where_column (kindt));
-	  ffebad_here (1, ffelex_token_where_line (typet),
-		       ffelex_token_where_column (typet));
-	  ffebad_finish ();
-	  kt = ktd;
-	}
-    }
-
-  ffestc_local_.decl.basic_type = bt;
-  ffestc_local_.decl.stmt_kind_type = kt;
-  ffestc_local_.decl.per_var_kind_ok = per_var_kind_ok;
-
-  /* Now check length specification for CHARACTER data type. */
-
-  if (((len == NULL) && (lent == NULL))
-      || (type != FFESTP_typeCHARACTER))
-    val = (type == FFESTP_typeCHARACTER) ? 1 : FFETARGET_charactersizeNONE;
-  else
-    {
-      if (len == NULL)
-	{
-	  assert (ffelex_token_type (lent) == FFELEX_typeNUMBER);
-	  val = atol (ffelex_token_text (lent));
-	}
-      else if (ffebld_op (len) == FFEBLD_opSTAR)
-	val = FFETARGET_charactersizeNONE;
-      else if (ffebld_op (len) == FFEBLD_opANY)
-	val = FFETARGET_charactersizeNONE;
-      else
-	{
-	  assert (ffebld_op (len) == FFEBLD_opCONTER);
-	  assert (ffeinfo_basictype (ffebld_info (len))
-		  == FFEINFO_basictypeINTEGER);
-	  assert (ffeinfo_kindtype (ffebld_info (len))
-		  == FFEINFO_kindtypeINTEGERDEFAULT);
-	  val = ffebld_constant_integerdefault (ffebld_conter (len));
-	}
-    }
-
-  if ((val == 0) && !(0 && ffe_is_90 ()))
-    {
-      val = 1;
-      ffebad_start (FFEBAD_ZERO_SIZE);
-      ffebad_here (0, ffelex_token_where_line (lent), ffelex_token_where_column (lent));
-      ffebad_finish ();
-    }
-  ffestc_local_.decl.stmt_size = val;
-}
-
-/* ffestc_establish_impletter_ -- Establish type/params for IMPLICIT letter(s)
-
-   ffestc_establish_impletter_(first_letter_token,last_letter_token);  */
-
-static void
-ffestc_establish_impletter_ (ffelexToken first, ffelexToken last)
-{
-  bool ok = FALSE;		/* Stays FALSE if first letter > last. */
-  char c;
-
-  if (last == NULL)
-    ok = ffeimplic_establish_initial (c = *(ffelex_token_text (first)),
-				      ffestc_local_.decl.basic_type,
-				      ffestc_local_.decl.kind_type,
-				      ffestc_local_.decl.size);
-  else
-    {
-      for (c = *(ffelex_token_text (first));
-	   c <= *(ffelex_token_text (last));
-	   c++)
-	{
-	  ok = ffeimplic_establish_initial (c,
-					    ffestc_local_.decl.basic_type,
-					    ffestc_local_.decl.kind_type,
-					    ffestc_local_.decl.size);
-	  if (!ok)
-	    break;
-	}
-    }
-
-  if (!ok)
-    {
-      char cs[2];
-
-      cs[0] = c;
-      cs[1] = '\0';
-
-      ffebad_start (FFEBAD_BAD_IMPLICIT);
-      ffebad_here (0, ffelex_token_where_line (first), ffelex_token_where_column (first));
-      ffebad_string (cs);
-      ffebad_finish ();
-    }
-}
-
-/* ffestc_init_3 -- Initialize ffestc for new program unit
-
-   ffestc_init_3();  */
-
-void
-ffestc_init_3 (void)
-{
-  ffestv_save_state_ = FFESTV_savestateNONE;
-  ffestc_entry_num_ = 0;
-  ffestv_num_label_defines_ = 0;
-}
-
-/* ffestc_init_4 -- Initialize ffestc for new scoping unit
-
-   ffestc_init_4();
-
-   For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
-   defs, and statement function defs.  */
-
-void
-ffestc_init_4 (void)
-{
-  ffestc_saved_entry_num_ = ffestc_entry_num_;
-  ffestc_entry_num_ = 0;
-}
-
-/* ffestc_kindtype_kind_ -- Determine kindtype from basictype and KIND= value
-
-   ffeinfoKindtype kt;
-   ffeinfoBasictype bt;
-   ffetargetCharacterSize val;
-   kt = ffestc_kindtype_kind_(bt,val);
-   if (kt == FFEINFO_kindtypeNONE)
-       // unsupported/invalid KIND= value for type  */
-
-static ffeinfoKindtype
-ffestc_kindtype_kind_ (ffeinfoBasictype bt, ffetargetCharacterSize val)
-{
-  ffetype type;
-  ffetype base_type;
-  ffeinfoKindtype kt;
-
-  base_type = ffeinfo_type (bt, 1);	/* ~~ */
-  assert (base_type != NULL);
-
-  type = ffetype_lookup_kind (base_type, (int) val);
-  if (type == NULL)
-    return FFEINFO_kindtypeNONE;
-
-  for (kt = 1; kt < FFEINFO_kindtype; ++kt)
-    if (ffeinfo_type (bt, kt) == type)
-      return kt;
-
-  return FFEINFO_kindtypeNONE;
-}
-
-/* ffestc_kindtype_star_ -- Determine kindtype from basictype and * value
-
-   ffeinfoKindtype kt;
-   ffeinfoBasictype bt;
-   ffetargetCharacterSize val;
-   kt = ffestc_kindtype_star_(bt,val);
-   if (kt == FFEINFO_kindtypeNONE)
-       // unsupported/invalid * value for type	*/
-
-static ffeinfoKindtype
-ffestc_kindtype_star_ (ffeinfoBasictype bt, ffetargetCharacterSize val)
-{
-  ffetype type;
-  ffetype base_type;
-  ffeinfoKindtype kt;
-
-  base_type = ffeinfo_type (bt, 1);	/* ~~ */
-  assert (base_type != NULL);
-
-  type = ffetype_lookup_star (base_type, (int) val);
-  if (type == NULL)
-    return FFEINFO_kindtypeNONE;
-
-  for (kt = 1; kt < FFEINFO_kindtype; ++kt)
-    if (ffeinfo_type (bt, kt) == type)
-      return kt;
-
-  return FFEINFO_kindtypeNONE;
-}
-
-/* Define label as usable for anything without complaint.  */
-
-static void
-ffestc_labeldef_any_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || !ffestc_labeldef_begin_ ())
-    return;
-
-  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-  ffestd_labeldef_any (ffestc_label_);
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_labeldef_begin_ -- Define label as unknown, initially
-
-   ffestc_labeldef_begin_();  */
-
-static bool
-ffestc_labeldef_begin_ (void)
-{
-  ffelabValue label_value;
-  ffelab label;
-
-  label_value = (ffelabValue) atol (ffelex_token_text (ffesta_label_token));
-  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
-    {
-      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_finish ();
-    }
-
-  label = ffelab_find (label_value);
-  if (label == NULL)
-    {
-      label = ffestc_label_ = ffelab_new (label_value);
-      ffestv_num_label_defines_++;
-      ffelab_set_definition_line (label,
-	  ffewhere_line_use (ffelex_token_where_line (ffesta_label_token)));
-      ffelab_set_definition_column (label,
-      ffewhere_column_use (ffelex_token_where_column (ffesta_label_token)));
-
-      return TRUE;
-    }
-
-  if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
-    {
-      ffestv_num_label_defines_++;
-      ffestc_label_ = label;
-      ffelab_set_definition_line (label,
-	  ffewhere_line_use (ffelex_token_where_line (ffesta_label_token)));
-      ffelab_set_definition_column (label,
-      ffewhere_column_use (ffelex_token_where_column (ffesta_label_token)));
-
-      return TRUE;
-    }
-
-  ffebad_start (FFEBAD_LABEL_ALREADY_DEFINED);
-  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-	       ffelex_token_where_column (ffesta_label_token));
-  ffebad_here (1, ffelab_definition_line (label),
-	       ffelab_definition_column (label));
-  ffebad_string (ffelex_token_text (ffesta_label_token));
-  ffebad_finish ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-  return FALSE;
-}
-
-/* ffestc_labeldef_branch_begin_ -- Define label as a branch target one
-
-   ffestc_labeldef_branch_begin_();  */
-
-static void
-ffestc_labeldef_branch_begin_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || (ffestc_shriek_after1_ != NULL)
-      || !ffestc_labeldef_begin_ ())
-    return;
-
-  switch (ffelab_type (ffestc_label_))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
-      ffelab_set_blocknum (ffestc_label_,
-			   ffestw_blocknum (ffestw_stack_top ()));
-      ffestd_labeldef_branch (ffestc_label_);
-      break;
-
-    case FFELAB_typeNOTLOOP:
-      if (ffelab_blocknum (ffestc_label_)
-	  < ffestw_blocknum (ffestw_stack_top ()))
-	{
-	  ffebad_start (FFEBAD_LABEL_BLOCK);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		       ffelab_firstref_column (ffestc_label_));
-	  ffebad_finish ();
-	}
-      ffelab_set_blocknum (ffestc_label_,
-			   ffestw_blocknum (ffestw_stack_top ()));
-      ffestd_labeldef_branch (ffestc_label_);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
-	{			/* Unterminated block. */
-	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-	  ffestd_labeldef_any (ffestc_label_);
-
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
-	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
-		       ffelab_doref_column (ffestc_label_));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffestd_labeldef_branch (ffestc_label_);
-      /* Leave something around for _branch_end_() to handle. */
-      return;
-
-    case FFELAB_typeFORMAT:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		   ffelab_firstref_column (ffestc_label_));
-      ffebad_finish ();
-      break;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* Define possible end of labeled-DO-loop.  Call only after calling
-   ffestc_labeldef_branch_begin_, or when other branch_* functions
-   recognize that a label might also be serving as a branch end (in
-   which case they must issue a diagnostic).  */
-
-static void
-ffestc_labeldef_branch_end_ (void)
-{
-  if (ffesta_label_token == NULL)
-    return;
-
-  assert (ffestc_label_ != NULL);
-  assert ((ffelab_type (ffestc_label_) == FFELAB_typeLOOPEND)
-	  || (ffelab_type (ffestc_label_) == FFELAB_typeANY));
-
-  while ((ffestw_state (ffestw_stack_top ()) == FFESTV_stateDO)
-	 && (ffestw_label (ffestw_stack_top ()) == ffestc_label_))
-    ffestc_shriek_do_ (TRUE);
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* ffestc_labeldef_endif_ -- Define label as an END IF one
-
-   ffestc_labeldef_endif_();  */
-
-static void
-ffestc_labeldef_endif_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || (ffestc_shriek_after1_ != NULL)
-      || !ffestc_labeldef_begin_ ())
-    return;
-
-  switch (ffelab_type (ffestc_label_))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (ffestc_label_, FFELAB_typeENDIF);
-      ffelab_set_blocknum (ffestc_label_,
-		   ffestw_blocknum (ffestw_previous (ffestw_stack_top ())));
-      ffestd_labeldef_endif (ffestc_label_);
-      break;
-
-    case FFELAB_typeNOTLOOP:
-      if (ffelab_blocknum (ffestc_label_)
-	  < ffestw_blocknum (ffestw_previous (ffestw_stack_top ())))
-	{
-	  ffebad_start (FFEBAD_LABEL_BLOCK);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		       ffelab_firstref_column (ffestc_label_));
-	  ffebad_finish ();
-	}
-      ffelab_set_blocknum (ffestc_label_,
-		   ffestw_blocknum (ffestw_previous (ffestw_stack_top ())));
-      ffestd_labeldef_endif (ffestc_label_);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
-	{			/* Unterminated block. */
-	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-	  ffestd_labeldef_any (ffestc_label_);
-
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
-	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
-		       ffelab_doref_column (ffestc_label_));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffestd_labeldef_endif (ffestc_label_);
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_doref_line (ffestc_label_),
-		   ffelab_doref_column (ffestc_label_));
-      ffebad_finish ();
-      ffestc_labeldef_branch_end_ ();
-      return;
-
-    case FFELAB_typeFORMAT:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		   ffelab_firstref_column (ffestc_label_));
-      ffebad_finish ();
-      break;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* ffestc_labeldef_format_ -- Define label as a FORMAT one
-
-   ffestc_labeldef_format_();  */
-
-static void
-ffestc_labeldef_format_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || (ffestc_shriek_after1_ != NULL))
-    {
-      ffebad_start (FFEBAD_FORMAT_NO_LABEL_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-      return;
-    }
-
-  if (!ffestc_labeldef_begin_ ())
-    return;
-
-  switch (ffelab_type (ffestc_label_))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (ffestc_label_, FFELAB_typeFORMAT);
-      ffestd_labeldef_format (ffestc_label_);
-      break;
-
-    case FFELAB_typeFORMAT:
-      ffestd_labeldef_format (ffestc_label_);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
-	{			/* Unterminated block. */
-	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-	  ffestd_labeldef_any (ffestc_label_);
-
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
-	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
-		       ffelab_doref_column (ffestc_label_));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffestd_labeldef_format (ffestc_label_);
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_doref_line (ffestc_label_),
-		   ffelab_doref_column (ffestc_label_));
-      ffebad_finish ();
-      ffestc_labeldef_branch_end_ ();
-      return;
-
-    case FFELAB_typeNOTLOOP:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		   ffelab_firstref_column (ffestc_label_));
-      ffebad_finish ();
-      break;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* ffestc_labeldef_invalid_ -- Label definition invalid, complain if present
-
-   ffestc_labeldef_invalid_();	*/
-
-static void
-ffestc_labeldef_invalid_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || (ffestc_shriek_after1_ != NULL)
-      || !ffestc_labeldef_begin_ ())
-    return;
-
-  ffebad_start (FFEBAD_INVALID_LABEL_DEF);
-  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-	       ffelex_token_where_column (ffesta_label_token));
-  ffebad_finish ();
-
-  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-  ffestd_labeldef_any (ffestc_label_);
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* Define label as a non-loop-ending one on a statement that can't
-   be in the "then" part of a logical IF, such as a block-IF statement.  */
-
-static void
-ffestc_labeldef_notloop_ (void)
-{
-  if (ffesta_label_token == NULL)
-    return;
-
-  assert (ffestc_shriek_after1_ == NULL);
-
-  if (!ffestc_labeldef_begin_ ())
-    return;
-
-  switch (ffelab_type (ffestc_label_))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
-      ffelab_set_blocknum (ffestc_label_,
-			   ffestw_blocknum (ffestw_stack_top ()));
-      ffestd_labeldef_notloop (ffestc_label_);
-      break;
-
-    case FFELAB_typeNOTLOOP:
-      if (ffelab_blocknum (ffestc_label_)
-	  < ffestw_blocknum (ffestw_stack_top ()))
-	{
-	  ffebad_start (FFEBAD_LABEL_BLOCK);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		       ffelab_firstref_column (ffestc_label_));
-	  ffebad_finish ();
-	}
-      ffelab_set_blocknum (ffestc_label_,
-			   ffestw_blocknum (ffestw_stack_top ()));
-      ffestd_labeldef_notloop (ffestc_label_);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
-	{			/* Unterminated block. */
-	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-	  ffestd_labeldef_any (ffestc_label_);
-
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
-	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
-		       ffelab_doref_column (ffestc_label_));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffestd_labeldef_notloop (ffestc_label_);
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_doref_line (ffestc_label_),
-		   ffelab_doref_column (ffestc_label_));
-      ffebad_finish ();
-      ffestc_labeldef_branch_end_ ();
-      return;
-
-    case FFELAB_typeFORMAT:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		   ffelab_firstref_column (ffestc_label_));
-      ffebad_finish ();
-      break;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* Define label as a non-loop-ending one.  Use this when it is
-   possible that the pending label is inhibited because we're in
-   the midst of a logical-IF, and thus _branch_end_ is going to
-   be called after the current statement to resolve a potential
-   loop-ending label.  */
-
-static void
-ffestc_labeldef_notloop_begin_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || (ffestc_shriek_after1_ != NULL)
-      || !ffestc_labeldef_begin_ ())
-    return;
-
-  switch (ffelab_type (ffestc_label_))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (ffestc_label_, FFELAB_typeNOTLOOP);
-      ffelab_set_blocknum (ffestc_label_,
-			   ffestw_blocknum (ffestw_stack_top ()));
-      ffestd_labeldef_notloop (ffestc_label_);
-      break;
-
-    case FFELAB_typeNOTLOOP:
-      if (ffelab_blocknum (ffestc_label_)
-	  < ffestw_blocknum (ffestw_stack_top ()))
-	{
-	  ffebad_start (FFEBAD_LABEL_BLOCK);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		       ffelab_firstref_column (ffestc_label_));
-	  ffebad_finish ();
-	}
-      ffelab_set_blocknum (ffestc_label_,
-			   ffestw_blocknum (ffestw_stack_top ()));
-      ffestd_labeldef_notloop (ffestc_label_);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
-	{			/* Unterminated block. */
-	  ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-	  ffestd_labeldef_any (ffestc_label_);
-
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
-	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
-		       ffelab_doref_column (ffestc_label_));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffestd_labeldef_branch (ffestc_label_);
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_doref_line (ffestc_label_),
-		   ffelab_doref_column (ffestc_label_));
-      ffebad_finish ();
-      return;
-
-    case FFELAB_typeFORMAT:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		   ffelab_firstref_column (ffestc_label_));
-      ffebad_finish ();
-      break;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* ffestc_labeldef_useless_ -- Define label as a useless one
-
-   ffestc_labeldef_useless_();	*/
-
-static void
-ffestc_labeldef_useless_ (void)
-{
-  if ((ffesta_label_token == NULL)
-      || (ffestc_shriek_after1_ != NULL)
-      || !ffestc_labeldef_begin_ ())
-    return;
-
-  switch (ffelab_type (ffestc_label_))
-    {
-    case FFELAB_typeUNKNOWN:
-      ffelab_set_type (ffestc_label_, FFELAB_typeUSELESS);
-      ffestd_labeldef_useless (ffestc_label_);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != ffestc_label_))
-	{			/* Unterminated block. */
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_END);
-	  ffebad_here (0, ffelab_doref_line (ffestc_label_),
-		       ffelab_doref_column (ffestc_label_));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (ffesta_label_token),
-		       ffelex_token_where_column (ffesta_label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_doref_line (ffestc_label_),
-		   ffelab_doref_column (ffestc_label_));
-      ffebad_finish ();
-      ffestc_labeldef_branch_end_ ();
-      return;
-
-    case FFELAB_typeASSIGNABLE:
-    case FFELAB_typeFORMAT:
-    case FFELAB_typeNOTLOOP:
-      ffelab_set_type (ffestc_label_, FFELAB_typeANY);
-      ffestd_labeldef_any (ffestc_label_);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelex_token_where_line (ffesta_label_token),
-		   ffelex_token_where_column (ffesta_label_token));
-      ffebad_here (1, ffelab_firstref_line (ffestc_label_),
-		   ffelab_firstref_column (ffestc_label_));
-      ffebad_finish ();
-      break;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  ffelex_token_kill (ffesta_label_token);
-  ffesta_label_token = NULL;
-}
-
-/* ffestc_labelref_is_assignable_ -- Reference to label in ASSIGN stmt
-
-   if (ffestc_labelref_is_assignable_(label_token,&label))
-       // label ref is ok, label is filled in with ffelab object  */
-
-static bool
-ffestc_labelref_is_assignable_ (ffelexToken label_token, ffelab *x_label)
-{
-  ffelab label;
-  ffelabValue label_value;
-
-  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
-  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
-    {
-      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
-      ffebad_here (0, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-      return FALSE;
-    }
-
-  label = ffelab_find (label_value);
-  if (label == NULL)
-    {
-      label = ffelab_new (label_value);
-      ffelab_set_firstref_line (label,
-		 ffewhere_line_use (ffelex_token_where_line (label_token)));
-      ffelab_set_firstref_column (label,
-	     ffewhere_column_use (ffelex_token_where_column (label_token)));
-    }
-
-  switch (ffelab_type (label))
-    {
-    case FFELAB_typeUNKNOWN:
-      ffelab_set_type (label, FFELAB_typeASSIGNABLE);
-      break;
-
-    case FFELAB_typeASSIGNABLE:
-    case FFELAB_typeLOOPEND:
-    case FFELAB_typeFORMAT:
-    case FFELAB_typeNOTLOOP:
-    case FFELAB_typeENDIF:
-      break;
-
-    case FFELAB_typeUSELESS:
-      ffelab_set_type (label, FFELAB_typeANY);
-      ffestd_labeldef_any (label);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
-      ffebad_here (1, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-
-      ffestc_try_shriek_do_ ();
-
-      return FALSE;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  *x_label = label;
-  return TRUE;
-}
-
-/* ffestc_labelref_is_branch_ -- Reference to label in branch stmt
-
-   if (ffestc_labelref_is_branch_(label_token,&label))
-       // label ref is ok, label is filled in with ffelab object  */
-
-static bool
-ffestc_labelref_is_branch_ (ffelexToken label_token, ffelab *x_label)
-{
-  ffelab label;
-  ffelabValue label_value;
-  ffestw block;
-  unsigned long blocknum;
-
-  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
-  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
-    {
-      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
-      ffebad_here (0, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-      return FALSE;
-    }
-
-  label = ffelab_find (label_value);
-  if (label == NULL)
-    {
-      label = ffelab_new (label_value);
-      ffelab_set_firstref_line (label,
-		 ffewhere_line_use (ffelex_token_where_line (label_token)));
-      ffelab_set_firstref_column (label,
-	     ffewhere_column_use (ffelex_token_where_column (label_token)));
-    }
-
-  switch (ffelab_type (label))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (label, FFELAB_typeNOTLOOP);
-      ffelab_set_blocknum (label, ffestw_blocknum (ffestw_stack_top ()));
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if (ffelab_blocknum (label) != 0)
-	break;			/* Already taken care of. */
-      for (block = ffestw_top_do (ffestw_stack_top ());
-	   (block != NULL) && (ffestw_label (block) != label);
-	   block = ffestw_top_do (ffestw_previous (block)))
-	;			/* Find most recent DO <label> ancestor. */
-      if (block == NULL)
-	{			/* Reference to within a (dead) block. */
-	  ffebad_start (FFEBAD_LABEL_BLOCK);
-	  ffebad_here (0, ffelab_definition_line (label),
-		       ffelab_definition_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffelab_set_blocknum (label, ffestw_blocknum (block));
-      ffelab_set_firstref_line (label,
-		 ffewhere_line_use (ffelex_token_where_line (label_token)));
-      ffelab_set_firstref_column (label,
-	     ffewhere_column_use (ffelex_token_where_column (label_token)));
-      break;
-
-    case FFELAB_typeNOTLOOP:
-    case FFELAB_typeENDIF:
-      if (ffelab_blocknum (label) == ffestw_blocknum (ffestw_stack_top ()))
-	break;
-      blocknum = ffelab_blocknum (label);
-      for (block = ffestw_stack_top ();
-	   ffestw_blocknum (block) > blocknum;
-	   block = ffestw_previous (block))
-	;			/* Find most recent common ancestor. */
-      if (ffelab_blocknum (label) == ffestw_blocknum (block))
-	break;			/* Check again. */
-      if (!ffewhere_line_is_unknown (ffelab_definition_line (label)))
-	{			/* Reference to within a (dead) block. */
-	  ffebad_start (FFEBAD_LABEL_BLOCK);
-	  ffebad_here (0, ffelab_definition_line (label),
-		       ffelab_definition_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-	  break;
-	}
-      ffelab_set_blocknum (label, ffestw_blocknum (block));
-      break;
-
-    case FFELAB_typeFORMAT:
-      if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
-	{
-	  ffelab_set_type (label, FFELAB_typeANY);
-	  ffestd_labeldef_any (label);
-
-	  ffebad_start (FFEBAD_LABEL_USE_USE);
-	  ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-
-	  ffestc_try_shriek_do_ ();
-
-	  return FALSE;
-	}
-      /* Fall through. */
-    case FFELAB_typeUSELESS:
-      ffelab_set_type (label, FFELAB_typeANY);
-      ffestd_labeldef_any (label);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
-      ffebad_here (1, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-
-      ffestc_try_shriek_do_ ();
-
-      return FALSE;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  *x_label = label;
-  return TRUE;
-}
-
-/* ffestc_labelref_is_format_ -- Reference to label in [FMT=] specification
-
-   if (ffestc_labelref_is_format_(label_token,&label))
-       // label ref is ok, label is filled in with ffelab object  */
-
-static bool
-ffestc_labelref_is_format_ (ffelexToken label_token, ffelab *x_label)
-{
-  ffelab label;
-  ffelabValue label_value;
-
-  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
-  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
-    {
-      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
-      ffebad_here (0, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-      return FALSE;
-    }
-
-  label = ffelab_find (label_value);
-  if (label == NULL)
-    {
-      label = ffelab_new (label_value);
-      ffelab_set_firstref_line (label,
-		 ffewhere_line_use (ffelex_token_where_line (label_token)));
-      ffelab_set_firstref_column (label,
-	     ffewhere_column_use (ffelex_token_where_column (label_token)));
-    }
-
-  switch (ffelab_type (label))
-    {
-    case FFELAB_typeUNKNOWN:
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_type (label, FFELAB_typeFORMAT);
-      break;
-
-    case FFELAB_typeFORMAT:
-      break;
-
-    case FFELAB_typeLOOPEND:
-    case FFELAB_typeNOTLOOP:
-      if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
-	{
-	  ffelab_set_type (label, FFELAB_typeANY);
-	  ffestd_labeldef_any (label);
-
-	  ffebad_start (FFEBAD_LABEL_USE_USE);
-	  ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-
-	  ffestc_try_shriek_do_ ();
-
-	  return FALSE;
-	}
-      /* Fall through. */
-    case FFELAB_typeUSELESS:
-    case FFELAB_typeENDIF:
-      ffelab_set_type (label, FFELAB_typeANY);
-      ffestd_labeldef_any (label);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
-      ffebad_here (1, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-
-      ffestc_try_shriek_do_ ();
-
-      return FALSE;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  ffestc_try_shriek_do_ ();
-
-  *x_label = label;
-  return TRUE;
-}
-
-/* ffestc_labelref_is_loopend_ -- Reference to label in DO stmt
-
-   if (ffestc_labelref_is_loopend_(label_token,&label))
-       // label ref is ok, label is filled in with ffelab object  */
-
-static bool
-ffestc_labelref_is_loopend_ (ffelexToken label_token, ffelab *x_label)
-{
-  ffelab label;
-  ffelabValue label_value;
-
-  label_value = (ffelabValue) atol (ffelex_token_text (label_token));
-  if ((label_value == 0) || (label_value > FFELAB_valueMAX))
-    {
-      ffebad_start (FFEBAD_LABEL_NUMBER_INVALID);
-      ffebad_here (0, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-      return FALSE;
-    }
-
-  label = ffelab_find (label_value);
-  if (label == NULL)
-    {
-      label = ffelab_new (label_value);
-      ffelab_set_doref_line (label,
-		 ffewhere_line_use (ffelex_token_where_line (label_token)));
-      ffelab_set_doref_column (label,
-	     ffewhere_column_use (ffelex_token_where_column (label_token)));
-    }
-
-  switch (ffelab_type (label))
-    {
-    case FFELAB_typeASSIGNABLE:
-      ffelab_set_doref_line (label,
-		 ffewhere_line_use (ffelex_token_where_line (label_token)));
-      ffelab_set_doref_column (label,
-	     ffewhere_column_use (ffelex_token_where_column (label_token)));
-      ffewhere_line_kill (ffelab_firstref_line (label));
-      ffelab_set_firstref_line (label, ffewhere_line_unknown ());
-      ffewhere_column_kill (ffelab_firstref_column (label));
-      ffelab_set_firstref_column (label, ffewhere_column_unknown ());
-      /* Fall through. */
-    case FFELAB_typeUNKNOWN:
-      ffelab_set_type (label, FFELAB_typeLOOPEND);
-      ffelab_set_blocknum (label, 0);
-      break;
-
-    case FFELAB_typeLOOPEND:
-      if (!ffewhere_line_is_unknown (ffelab_definition_line (label)))
-	{			/* Def must follow all refs. */
-	  ffelab_set_type (label, FFELAB_typeANY);
-	  ffestd_labeldef_any (label);
-
-	  ffebad_start (FFEBAD_LABEL_DEF_DO);
-	  ffebad_here (0, ffelab_definition_line (label),
-		       ffelab_definition_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-
-	  ffestc_try_shriek_do_ ();
-
-	  return FALSE;
-	}
-      if (ffelab_blocknum (label) != 0)
-	{			/* Had a branch ref earlier, can't go inside
-				   this new block! */
-	  ffelab_set_type (label, FFELAB_typeANY);
-	  ffestd_labeldef_any (label);
-
-	  ffebad_start (FFEBAD_LABEL_USE_USE);
-	  ffebad_here (0, ffelab_firstref_line (label),
-		       ffelab_firstref_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-
-	  ffestc_try_shriek_do_ ();
-
-	  return FALSE;
-	}
-      if ((ffestw_state (ffestw_stack_top ()) != FFESTV_stateDO)
-	  || (ffestw_label (ffestw_stack_top ()) != label))
-	{			/* Top of stack interrupts flow between two
-				   DOs specifying label. */
-	  ffelab_set_type (label, FFELAB_typeANY);
-	  ffestd_labeldef_any (label);
-
-	  ffebad_start (FFEBAD_LABEL_DO_BLOCK_DO);
-	  ffebad_here (0, ffelab_doref_line (label),
-		       ffelab_doref_column (label));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_here (2, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-
-	  ffestc_try_shriek_do_ ();
-
-	  return FALSE;
-	}
-      break;
-
-    case FFELAB_typeNOTLOOP:
-    case FFELAB_typeFORMAT:
-      if (ffewhere_line_is_unknown (ffelab_definition_line (label)))
-	{
-	  ffelab_set_type (label, FFELAB_typeANY);
-	  ffestd_labeldef_any (label);
-
-	  ffebad_start (FFEBAD_LABEL_USE_USE);
-	  ffebad_here (0, ffelab_firstref_line (label), ffelab_firstref_column (label));
-	  ffebad_here (1, ffelex_token_where_line (label_token),
-		       ffelex_token_where_column (label_token));
-	  ffebad_finish ();
-
-	  ffestc_try_shriek_do_ ();
-
-	  return FALSE;
-	}
-      /* Fall through. */
-    case FFELAB_typeUSELESS:
-    case FFELAB_typeENDIF:
-      ffelab_set_type (label, FFELAB_typeANY);
-      ffestd_labeldef_any (label);
-
-      ffebad_start (FFEBAD_LABEL_USE_DEF);
-      ffebad_here (0, ffelab_definition_line (label), ffelab_definition_column (label));
-      ffebad_here (1, ffelex_token_where_line (label_token),
-		   ffelex_token_where_column (label_token));
-      ffebad_finish ();
-
-      ffestc_try_shriek_do_ ();
-
-      return FALSE;
-
-    default:
-      assert ("bad label" == NULL);
-      /* Fall through.  */
-    case FFELAB_typeANY:
-      break;
-    }
-
-  *x_label = label;
-  return TRUE;
-}
-
-/* ffestc_order_actiondo_ -- Check ordering on <actiondo> statement
-
-   if (ffestc_order_actiondo_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_actiondo_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateDO:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateSELECT1:
-      if (ffestw_top_do (ffestw_stack_top ()) == NULL)
-	break;
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateIF:
-      if (ffestw_top_do (ffestw_stack_top ()) == NULL)
-	break;
-      ffestc_shriek_after1_ = ffestc_shriek_if_;
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-
-    default:
-      break;
-    }
-  ffestc_order_bad_ ();
-  return FFESTC_orderBAD_;
-}
-
-/* ffestc_order_actionif_ -- Check ordering on <actionif> statement
-
-   if (ffestc_order_actionif_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_actionif_ (void)
-{
-  bool update;
-
-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:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-      update = FALSE;
-      break;
-
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateIF:
-      ffestc_shriek_after1_ = ffestc_shriek_if_;
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-
-    default:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-    }
-
-  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
-    {
-    case FFESTV_stateINTERFACE0:
-      ffestc_order_bad_ ();
-      if (update)
-	ffestw_update (NULL);
-      return FFESTC_orderBAD_;
-
-    default:
-      if (update)
-	ffestw_update (NULL);
-      return FFESTC_orderOK_;
-    }
-}
-
-/* ffestc_order_actionwhere_ -- Check ordering on <actionwhere> statement
-
-   if (ffestc_order_actionwhere_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_actionwhere_ (void)
-{
-  bool update;
-
-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:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-      update = FALSE;
-      break;
-
-    case FFESTV_stateWHERETHEN:
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERE:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateIF:
-      ffestc_shriek_after1_ = ffestc_shriek_if_;
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    default:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-    }
-
-  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
-    {
-    case FFESTV_stateINTERFACE0:
-      ffestc_order_bad_ ();
-      if (update)
-	ffestw_update (NULL);
-      return FFESTC_orderBAD_;
-
-    default:
-      if (update)
-	ffestw_update (NULL);
-      return FFESTC_orderOK_;
-    }
-}
-
-/* Check ordering on "any" statement.  Like _actionwhere_, but
-   doesn't produce any diagnostics.  */
-
-static void
-ffestc_order_any_ (void)
-{
-  bool update;
-
-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:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-      update = FALSE;
-      break;
-
-    case FFESTV_stateWHERETHEN:
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT1:
-      return;
-
-    case FFESTV_stateWHERE:
-      return;
-
-    case FFESTV_stateIF:
-      ffestc_shriek_after1_ = ffestc_shriek_if_;
-      return;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    default:
-      return;
-    }
-
-  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
-    {
-    case FFESTV_stateINTERFACE0:
-      if (update)
-	ffestw_update (NULL);
-      return;
-
-    default:
-      if (update)
-	ffestw_update (NULL);
-      return;
-    }
-}
-
-/* ffestc_order_bad_ -- Whine about statement ordering violation
-
-   ffestc_order_bad_();
-
-   Uses current ffesta_tokens[0] and, if available, info on where current
-   state started to produce generic message.  Someday we should do
-   fancier things than this, but this just gets things creaking along for
-   now.	 */
-
-static void
-ffestc_order_bad_ (void)
-{
-  if (ffewhere_line_is_unknown (ffestw_line (ffestw_stack_top ())))
-    {
-      ffebad_start (FFEBAD_ORDER_1);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-    }
-  else
-    {
-      ffebad_start (FFEBAD_ORDER_2);
-      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_labeldef_useless_ ();	/* Any label definition is useless. */
-}
-
-/* ffestc_order_blockdata_ -- Check ordering on <blockdata> statement
-
-   if (ffestc_order_blockdata_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_blockdata_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-    case FFESTV_stateBLOCKDATA2:
-    case FFESTV_stateBLOCKDATA3:
-    case FFESTV_stateBLOCKDATA4:
-    case FFESTV_stateBLOCKDATA5:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_blockspec_ -- Check ordering on <blockspec> statement
-
-   if (ffestc_order_blockspec_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_blockspec_ (void)
-{
-  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:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_data_ -- Check ordering on DATA statement
-
-   if (ffestc_order_data_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_data_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_statePROGRAM0:
-    case FFESTV_statePROGRAM1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_statePROGRAM2:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateBLOCKDATA2:
-    case FFESTV_statePROGRAM3:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateBLOCKDATA3:
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-    case FFESTV_stateBLOCKDATA4:
-    case FFESTV_stateWHERETHEN:
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT0:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_data77_ -- Check ordering on pedantic-F77 DATA statement
-
-   if (ffestc_order_data77_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_data77_ (void)
-{
-  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:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-    case FFESTV_stateBLOCKDATA2:
-    case FFESTV_stateBLOCKDATA3:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA4);
-      return FFESTC_orderOK_;
-
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-    case FFESTV_stateBLOCKDATA4:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERETHEN:
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT0:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_do_ -- Check ordering on <do> statement
-
-   if (ffestc_order_do_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_do_ (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateDO:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_entry_ -- Check ordering on ENTRY statement
-
-   if (ffestc_order_entry_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_entry_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateSUBROUTINE0:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
-      break;
-
-    case FFESTV_stateFUNCTION0:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
-      break;
-
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-      break;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-
-    case FFESTV_stateIF:
-      ffestc_order_bad_ ();
-      ffestc_shriek_if_ (FALSE);
-      return FFESTC_orderBAD_;
-
-    default:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-    }
-
-  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
-    {
-    case FFESTV_stateNIL:
-    case FFESTV_stateMODULE5:
-      ffestw_update (NULL);
-      return FFESTC_orderOK_;
-
-    default:
-      ffestc_order_bad_ ();
-      ffestw_update (NULL);
-      return FFESTC_orderBAD_;
-    }
-}
-
-/* ffestc_order_exec_ -- Check ordering on <exec> statement
-
-   if (ffestc_order_exec_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_exec_ (void)
-{
-  bool update;
-
-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:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE4);
-      update = TRUE;
-      break;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION4);
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-      update = FALSE;
-      break;
-
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-
-    case FFESTV_stateIF:
-      ffestc_order_bad_ ();
-      ffestc_shriek_if_ (FALSE);
-      return FFESTC_orderBAD_;
-
-    default:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-    }
-
-  switch (ffestw_state (ffestw_previous (ffestw_stack_top ())))
-    {
-    case FFESTV_stateINTERFACE0:
-      ffestc_order_bad_ ();
-      if (update)
-	ffestw_update (NULL);
-      return FFESTC_orderBAD_;
-
-    default:
-      if (update)
-	ffestw_update (NULL);
-      return FFESTC_orderOK_;
-    }
-}
-
-/* ffestc_order_format_ -- Check ordering on FORMAT statement
-
-   if (ffestc_order_format_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_format_ (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);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateSUBROUTINE0:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE1);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateFUNCTION0:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION1);
-      return FFESTC_orderOK_;
-
-    case FFESTV_statePROGRAM1:
-    case FFESTV_statePROGRAM2:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_statePROGRAM3:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-    case FFESTV_stateWHERETHEN:
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT0:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_function_ -- Check ordering on <function> statement
-
-   if (ffestc_order_function_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_function_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateFUNCTION4:
-    case FFESTV_stateFUNCTION5:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_iface_ -- Check ordering on <iface> statement
-
-   if (ffestc_order_iface_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_iface_ (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-    case FFESTV_statePROGRAM5:
-    case FFESTV_stateSUBROUTINE5:
-    case FFESTV_stateFUNCTION5:
-    case FFESTV_stateMODULE5:
-    case FFESTV_stateINTERFACE0:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_ifthen_ -- Check ordering on <ifthen> statement
-
-   if (ffestc_order_ifthen_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_ifthen_ (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateIFTHEN:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_implicit_ -- Check ordering on IMPLICIT statement
-
-   if (ffestc_order_implicit_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_implicit_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_statePROGRAM0:
-    case FFESTV_statePROGRAM1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateMODULE0:
-    case FFESTV_stateMODULE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_statePROGRAM2:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateMODULE2:
-    case FFESTV_stateBLOCKDATA2:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_implicitnone_ -- Check ordering on IMPLICIT NONE statement
-
-   if (ffestc_order_implicitnone_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_implicitnone_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_statePROGRAM0:
-    case FFESTV_statePROGRAM1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM3);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE3);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION3);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateMODULE0:
-    case FFESTV_stateMODULE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE3);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA3);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_parameter_ -- Check ordering on <parameter> statement
-
-   if (ffestc_order_parameter_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_parameter_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_statePROGRAM0:
-    case FFESTV_statePROGRAM1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_statePROGRAM2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSUBROUTINE2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateFUNCTION2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateMODULE0:
-    case FFESTV_stateMODULE1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateMODULE2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
-      return FFESTC_orderOK_;
-
-    case FFESTV_statePROGRAM2:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateMODULE2:
-    case FFESTV_stateBLOCKDATA2:
-    case FFESTV_statePROGRAM3:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateMODULE3:
-    case FFESTV_stateBLOCKDATA3:
-    case FFESTV_stateTYPE:	/* GNU extension here! */
-    case FFESTV_stateSTRUCTURE:
-    case FFESTV_stateUNION:
-    case FFESTV_stateMAP:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_program_ -- Check ordering on <program> statement
-
-   if (ffestc_order_program_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_program_ (void)
-{
-  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:
-    case FFESTV_statePROGRAM5:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_progspec_ -- Check ordering on <progspec> statement
-
-   if (ffestc_order_progspec_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_progspec_ (void)
-{
-  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_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-    case FFESTV_stateBLOCKDATA2:
-      ffestw_update (NULL);
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateBLOCKDATA2);
-      if (ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_BLOCKDATA_STMT);
-	  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 FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_selectcase_ -- Check ordering on <selectcase> statement
-
-   if (ffestc_order_selectcase_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_selectcase_ (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateSELECT0:
-    case FFESTV_stateSELECT1:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_sfunc_ -- Check ordering on statement-function definition
-
-   if (ffestc_order_sfunc_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_sfunc_ (void)
-{
-  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_statePROGRAM3:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_subroutine_ -- Check ordering on <subroutine> statement
-
-   if (ffestc_order_subroutine_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_subroutine_ (void)
-{
-  recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateSUBROUTINE5:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_typedecl_ -- Check ordering on <typedecl> statement
-
-   if (ffestc_order_typedecl_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_typedecl_ (void)
-{
-  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:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      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_unit_ -- Check ordering on <unit> statement
-
-   if (ffestc_order_unit_() != FFESTC_orderOK_)
-       return;	*/
-
-static ffestcOrder_
-ffestc_order_unit_ (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      return FFESTC_orderOK_;
-
-    case FFESTV_stateWHERE:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-
-    case FFESTV_stateIF:
-      ffestc_order_bad_ ();
-      ffestc_shriek_if_ (FALSE);
-      return FFESTC_orderBAD_;
-
-    default:
-      ffestc_order_bad_ ();
-      return FFESTC_orderBAD_;
-    }
-}
-/* Invoked for each token in dummy arg list of FUNCTION, SUBROUTINE, and
-   ENTRY (prior to the first executable statement).  */
-
-static void
-ffestc_promote_dummy_ (ffelexToken t)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffebld e;
-  bool sfref_ok;
-
-  assert (t != NULL);
-
-  if (ffelex_token_type (t) == FFELEX_typeASTERISK)
-    {
-      ffebld_append_item (&ffestc_local_.dummy.list_bottom,
-			  ffebld_new_star ());
-      return;			/* Don't bother with alternate returns! */
-    }
-
-  s = ffesymbol_declare_local (t, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  sfref_ok = FALSE;
-
-  if (sa & FFESYMBOL_attrsANY)
-    na = sa;
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      if (ffestc_entry_num_ == ffesymbol_maxentrynum (s))
-	{			/* Seen this one twice in this list! */
-	  na = FFESYMBOL_attrsetNONE;
-	}
-      else
-	na = sa;
-      sfref_ok = TRUE;		/* Ok for sym to be ref'd in sfuncdef
-				   previously, since already declared as a
-				   dummy arg. */
-    }
-  else if (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
-		    | FFESYMBOL_attrsADJUSTS
-		    | FFESYMBOL_attrsANY
-		    | FFESYMBOL_attrsANYLEN
-		    | FFESYMBOL_attrsANYSIZE
-		    | FFESYMBOL_attrsARRAY
-		    | FFESYMBOL_attrsDUMMY
-		    | FFESYMBOL_attrsEXTERNAL
-		    | FFESYMBOL_attrsSFARG
-		    | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsDUMMY;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  if (!ffesymbol_is_specable (s)
-      && (!sfref_ok
-	  || (ffesymbol_where (s) != FFEINFO_whereDUMMY)))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_set_maxentrynum (s, ffestc_entry_num_);
-      ffesymbol_set_numentries (s, ffesymbol_numentries (s) + 1);
-      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-			     FFEINTRIN_impNONE);
-      ffebld_set_info (e,
-		       ffeinfo_new (FFEINFO_basictypeNONE,
-				    FFEINFO_kindtypeNONE,
-				    0,
-				    FFEINFO_kindNONE,
-				    FFEINFO_whereNONE,
-				    FFETARGET_charactersizeNONE));
-      ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
-      ffesymbol_signal_unreported (s);
-    }
-}
-
-/* ffestc_promote_execdummy_ -- Declare token as dummy variable in exec context
-
-   ffestc_promote_execdummy_(t);
-
-   Invoked for each token in dummy arg list of ENTRY when the statement
-   follows the first executable statement.  */
-
-static void
-ffestc_promote_execdummy_ (ffelexToken t)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffesymbolState ss;
-  ffesymbolState ns;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  ffebld e;
-
-  assert (t != NULL);
-
-  if (ffelex_token_type (t) == FFELEX_typeASTERISK)
-    {
-      ffebld_append_item (&ffestc_local_.dummy.list_bottom,
-			  ffebld_new_star ());
-      return;			/* Don't bother with alternate returns! */
-    }
-
-  s = ffesymbol_declare_local (t, FALSE);
-  na = sa = ffesymbol_attrs (s);
-  ss = ffesymbol_state (s);
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  if (ffestc_entry_num_ == ffesymbol_maxentrynum (s))
-    {				/* Seen this one twice in this list! */
-      na = FFESYMBOL_attrsetNONE;
-    }
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  ns = FFESYMBOL_stateUNDERSTOOD;	/* Assume we know it all know. */
-
-  switch (kind)
-    {
-    case FFEINFO_kindENTITY:
-    case FFEINFO_kindFUNCTION:
-    case FFEINFO_kindSUBROUTINE:
-      break;			/* These are fine, as far as we know. */
-
-    case FFEINFO_kindNONE:
-      if (sa & FFESYMBOL_attrsDUMMY)
-	ns = FFESYMBOL_stateUNCERTAIN;	/* Learned nothing new. */
-      else if (sa & FFESYMBOL_attrsANYLEN)
-	{
-	  kind = FFEINFO_kindENTITY;
-	  where = FFEINFO_whereDUMMY;
-	}
-      else if (sa & FFESYMBOL_attrsACTUALARG)
-	na = FFESYMBOL_attrsetNONE;
-      else
-	{
-	  na = sa | FFESYMBOL_attrsDUMMY;
-	  ns = FFESYMBOL_stateUNCERTAIN;
-	}
-      break;
-
-    default:
-      na = FFESYMBOL_attrsetNONE;	/* Error. */
-      break;
-    }
-
-  switch (where)
-    {
-    case FFEINFO_whereDUMMY:
-      break;			/* This is fine. */
-
-    case FFEINFO_whereNONE:
-      where = FFEINFO_whereDUMMY;
-      break;
-
-    default:
-      na = FFESYMBOL_attrsetNONE;	/* Error. */
-      break;
-    }
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, t);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, ns);
-      ffesymbol_set_maxentrynum (s, ffestc_entry_num_);
-      ffesymbol_set_numentries (s, ffesymbol_numentries (s) + 1);
-      if ((ns == FFESYMBOL_stateUNDERSTOOD)
-	  && (kind != FFEINFO_kindSUBROUTINE)
-	  && !ffeimplic_establish_symbol (s))
-	{
-	  ffesymbol_error (s, t);
-	  return;
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       kind,
-				       where,
-				       ffesymbol_size (s)));
-      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-			     FFEINTRIN_impNONE);
-      ffebld_set_info (e, ffeinfo_use (ffesymbol_info (s)));
-      ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
-      s = ffecom_sym_learned (s);
-      ffesymbol_signal_unreported (s);
-    }
-}
-
-/* ffestc_promote_sfdummy_ -- Declare token as stmt-func dummy variable
-
-   ffestc_promote_sfdummy_(t);
-
-   Invoked for each token in dummy arg list of statement function.
-
-   22-Oct-91  JCB  1.1
-      Reject arg if CHARACTER*(*).  */
-
-static void
-ffestc_promote_sfdummy_ (ffelexToken t)
-{
-  ffesymbol s;
-  ffesymbol sp;			/* Parent symbol. */
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffebld e;
-
-  assert (t != NULL);
-
-  s = ffesymbol_declare_sfdummy (t);	/* Sets maxentrynum to 0 for new obj;
-					   also sets sfa_dummy_parent to
-					   parent symbol. */
-  if (ffesymbol_state (s) != FFESYMBOL_stateNONE)
-    {
-      ffesymbol_error (s, t);	/* Dummy already in list. */
-      return;
-    }
-
-  sp = ffesymbol_sfdummyparent (s);	/* Now flag dummy's parent as used
-					   for dummy. */
-  sa = ffesymbol_attrs (sp);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (sp)
-      && ((ffesymbol_kind (sp) != FFEINFO_kindENTITY)
-	  || ((ffesymbol_where (sp) != FFEINFO_whereLOCAL)
-	      && (ffesymbol_where (sp) != FFEINFO_whereCOMMON)
-	      && (ffesymbol_where (sp) != FFEINFO_whereDUMMY)
-	      && (ffesymbol_where (sp) != FFEINFO_whereNONE))))
-    na = FFESYMBOL_attrsetNONE;	/* Can't be PARAMETER etc., must be a var. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = sa;
-  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		    | FFESYMBOL_attrsCOMMON
-		    | FFESYMBOL_attrsDUMMY
-		    | FFESYMBOL_attrsEQUIV
-		    | FFESYMBOL_attrsINIT
-		    | FFESYMBOL_attrsNAMELIST
-		    | FFESYMBOL_attrsRESULT
-		    | FFESYMBOL_attrsSAVE
-		    | FFESYMBOL_attrsSFARG
-		    | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsSFARG;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    {
-      ffesymbol_error (sp, t);
-      ffesymbol_set_info (s, ffeinfo_new_any ());
-    }
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_state (sp, FFESYMBOL_stateSEEN);
-      ffesymbol_set_attrs (sp, na);
-      if (!ffeimplic_establish_symbol (sp)
-	  || ((ffesymbol_basictype (sp) == FFEINFO_basictypeCHARACTER)
-	      && (ffesymbol_size (sp) == FFETARGET_charactersizeNONE)))
-	ffesymbol_error (sp, t);
-      else
-	ffesymbol_set_info (s,
-			    ffeinfo_new (ffesymbol_basictype (sp),
-					 ffesymbol_kindtype (sp),
-					 0,
-					 FFEINFO_kindENTITY,
-					 FFEINFO_whereDUMMY,
-					 ffesymbol_size (sp)));
-
-      ffesymbol_signal_unreported (sp);
-    }
-
-  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-  ffesymbol_set_maxentrynum (s, ffestc_sfdummy_argno_++);
-  ffesymbol_signal_unreported (s);
-  e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-			 FFEINTRIN_impNONE);
-  ffebld_set_info (e, ffeinfo_use (ffesymbol_info (s)));
-  ffebld_append_item (&ffestc_local_.dummy.list_bottom, e);
-}
-
-/* ffestc_shriek_begin_program_ -- Implicit PROGRAM statement
-
-   ffestc_shriek_begin_program_();
-
-   Invoked only when a PROGRAM statement is NOT present at the beginning
-   of a main program unit.  */
-
-static void
-ffestc_shriek_begin_program_ (void)
-{
-  ffestw b;
-  ffesymbol s;
-
-  ffestc_blocknum_ = 0;
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, NULL);
-  ffestw_set_state (b, FFESTV_statePROGRAM0);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_end_program_);
-  ffestw_set_name (b, NULL);
-
-  s = ffesymbol_declare_programunit (NULL,
-				 ffelex_token_where_line (ffesta_tokens[0]),
-			      ffelex_token_where_column (ffesta_tokens[0]));
-
-  /* Special case: this is one symbol that won't go through
-     ffestu_exec_transition_ when the first statement in a main program is
-     executable, because the transition happens in ffest before ffestc is
-     reached and triggers the implicit generation of a main program.  So we
-     do the exec transition for the implicit main program right here, just
-     for cleanliness' sake (at the very least). */
-
-  ffesymbol_set_info (s,
-		      ffeinfo_new (FFEINFO_basictypeNONE,
-				   FFEINFO_kindtypeNONE,
-				   0,
-				   FFEINFO_kindPROGRAM,
-				   FFEINFO_whereLOCAL,
-				   FFETARGET_charactersizeNONE));
-  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-
-  ffesymbol_signal_unreported (s);
-
-  ffestd_R1102 (s, NULL);
-}
-
-/* ffestc_shriek_blockdata_ -- End a BLOCK DATA
-
-   ffestc_shriek_blockdata_(TRUE);  */
-
-static void
-ffestc_shriek_blockdata_ (bool ok)
-{
-  if (!ffesta_seen_first_exec)
-    {
-      ffesta_seen_first_exec = TRUE;
-      ffestd_exec_begin ();
-    }
-
-  ffestd_R1112 (ok);
-
-  ffestd_exec_end ();
-
-  if (ffestw_name (ffestw_stack_top ()) != NULL)
-    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  ffestw_kill (ffestw_pop ());
-
-  ffe_terminate_2 ();
-  ffe_init_2 ();
-}
-
-/* ffestc_shriek_do_ -- End of statement following DO-term-stmt etc
-
-   ffestc_shriek_do_(TRUE);
-
-   Also invoked by _labeldef_branch_end_ (or, in cases
-   of errors, other _labeldef_ functions) when the label definition is
-   for a DO-target (LOOPEND) label, once per matching/outstanding DO
-   block on the stack.	These cases invoke this function with ok==TRUE, so
-   only forced stack popping (via ffestc_eof()) invokes it with ok==FALSE.  */
-
-static void
-ffestc_shriek_do_ (bool ok)
-{
-  ffelab l;
-
-  if (((l = ffestw_label (ffestw_stack_top ())) != NULL)
-      && (ffewhere_line_is_unknown (ffelab_definition_line (l))))
-    {				/* DO target is label that is still
-				   undefined. */
-      assert ((ffelab_type (l) == FFELAB_typeLOOPEND)
-	      || (ffelab_type (l) == FFELAB_typeANY));
-      if (ffelab_type (l) != FFELAB_typeANY)
-	{
-	  ffelab_set_definition_line (l,
-				      ffewhere_line_use (ffelab_doref_line (l)));
-	  ffelab_set_definition_column (l,
-					ffewhere_column_use (ffelab_doref_column (l)));
-	  ffestv_num_label_defines_++;
-	}
-      ffestd_labeldef_branch (l);
-    }
-
-  ffestd_do (ok);
-
-  if (ffestw_name (ffestw_stack_top ()) != NULL)
-    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  if (ffestw_do_iter_var_t (ffestw_stack_top ()) != NULL)
-    ffelex_token_kill (ffestw_do_iter_var_t (ffestw_stack_top ()));
-  if (ffestw_do_iter_var (ffestw_stack_top ()) != NULL)
-    ffesymbol_set_is_doiter (ffestw_do_iter_var (ffestw_stack_top ()), FALSE);
-  ffestw_kill (ffestw_pop ());
-}
-
-/* ffestc_shriek_end_program_ -- End a PROGRAM
-
-   ffestc_shriek_end_program_();  */
-
-static void
-ffestc_shriek_end_program_ (bool ok)
-{
-  if (!ffesta_seen_first_exec)
-    {
-      ffesta_seen_first_exec = TRUE;
-      ffestd_exec_begin ();
-    }
-
-  ffestd_R1103 (ok);
-
-  ffestd_exec_end ();
-
-  if (ffestw_name (ffestw_stack_top ()) != NULL)
-    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  ffestw_kill (ffestw_pop ());
-
-  ffe_terminate_2 ();
-  ffe_init_2 ();
-}
-
-/* ffestc_shriek_function_ -- End a FUNCTION
-
-   ffestc_shriek_function_(TRUE);  */
-
-static void
-ffestc_shriek_function_ (bool ok)
-{
-  if (!ffesta_seen_first_exec)
-    {
-      ffesta_seen_first_exec = TRUE;
-      ffestd_exec_begin ();
-    }
-
-  ffestd_R1221 (ok);
-
-  ffestd_exec_end ();
-
-  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  ffestw_kill (ffestw_pop ());
-  ffesta_is_entry_valid = FALSE;
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffe_terminate_2 ();
-      ffe_init_2 ();
-      break;
-
-    default:
-      ffe_terminate_3 ();
-      ffe_init_3 ();
-      break;
-
-    case FFESTV_stateINTERFACE0:
-      ffe_terminate_4 ();
-      ffe_init_4 ();
-      break;
-    }
-}
-
-/* ffestc_shriek_if_ -- End of statement following logical IF
-
-   ffestc_shriek_if_(TRUE);
-
-   Applies ONLY to logical IF, not to IF-THEN.	For example, does not
-   ffelex_token_kill the construct name for an IF-THEN block (the name
-   field is invalid for logical IF).  ok==TRUE iff statement following
-   logical IF (substatement) is valid; else, statement is invalid or
-   stack forcibly popped due to ffestc_eof().  */
-
-static void
-ffestc_shriek_if_ (bool ok)
-{
-  ffestd_end_R807 (ok);
-
-  ffestw_kill (ffestw_pop ());
-  ffestc_shriek_after1_ = NULL;
-
-  ffestc_try_shriek_do_ ();
-}
-
-/* ffestc_shriek_ifthen_ -- End an IF-THEN
-
-   ffestc_shriek_ifthen_(TRUE);	 */
-
-static void
-ffestc_shriek_ifthen_ (bool ok)
-{
-  ffestd_R806 (ok);
-
-  if (ffestw_name (ffestw_stack_top ()) != NULL)
-    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  ffestw_kill (ffestw_pop ());
-
-  ffestc_try_shriek_do_ ();
-}
-
-/* ffestc_shriek_select_ -- End a SELECT
-
-   ffestc_shriek_select_(TRUE);	 */
-
-static void
-ffestc_shriek_select_ (bool ok)
-{
-  ffestwSelect s;
-  ffestwCase c;
-
-  ffestd_R811 (ok);
-
-  if (ffestw_name (ffestw_stack_top ()) != NULL)
-    ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  s = ffestw_select (ffestw_stack_top ());
-  ffelex_token_kill (s->t);
-  for (c = s->first_rel; c != (ffestwCase) &s->first_rel; c = c->next_rel)
-    ffelex_token_kill (c->t);
-  malloc_pool_kill (s->pool);
-
-  ffestw_kill (ffestw_pop ());
-
-  ffestc_try_shriek_do_ ();
-}
-
-/* ffestc_shriek_subroutine_ -- End a SUBROUTINE
-
-   ffestc_shriek_subroutine_(TRUE);  */
-
-static void
-ffestc_shriek_subroutine_ (bool ok)
-{
-  if (!ffesta_seen_first_exec)
-    {
-      ffesta_seen_first_exec = TRUE;
-      ffestd_exec_begin ();
-    }
-
-  ffestd_R1225 (ok);
-
-  ffestd_exec_end ();
-
-  ffelex_token_kill (ffestw_name (ffestw_stack_top ()));
-  ffestw_kill (ffestw_pop ());
-  ffesta_is_entry_valid = FALSE;
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffe_terminate_2 ();
-      ffe_init_2 ();
-      break;
-
-    default:
-      ffe_terminate_3 ();
-      ffe_init_3 ();
-      break;
-
-    case FFESTV_stateINTERFACE0:
-      ffe_terminate_4 ();
-      ffe_init_4 ();
-      break;
-    }
-}
-
-/* ffestc_subr_binsrch_ -- Binary search of char const in list of strings
-
-   i = ffestc_subr_binsrch_(search_list,search_list_size,&spec,"etc");
-
-   search_list contains search_list_size char *'s, spec is checked to see
-   if it is a char constant and, if so, is binary-searched against the list.
-   0 is returned if not found, else the "classic" index (beginning with 1)
-   is returned.	 Before returning 0 where the search was performed but
-   fruitless, if "etc" is a non-NULL char *, an error message is displayed
-   using "etc" as the pick-one-of-these string.	 */
-
-static int
-ffestc_subr_binsrch_ (const char *const *list, int size, ffestpFile *spec,
-		      const char *whine)
-{
-  int lowest_tested;
-  int highest_tested;
-  int halfway;
-  int offset;
-  int c;
-  const char *str;
-  int len;
-
-  if (size == 0)
-    return 0;			/* Nobody should pass size == 0, but for
-				   elegance.... */
-
-  lowest_tested = -1;
-  highest_tested = size;
-  halfway = size >> 1;
-
-  list += halfway;
-
-  c = ffestc_subr_speccmp_ (*list, spec, &str, &len);
-  if (c == 2)
-    return 0;
-  c = -c;			/* Sigh.  */
-
-next:				/* :::::::::::::::::::: */
-  switch (c)
-    {
-    case -1:
-      offset = (halfway - lowest_tested) >> 1;
-      if (offset == 0)
-	goto nope;		/* :::::::::::::::::::: */
-      highest_tested = halfway;
-      list -= offset;
-      halfway -= offset;
-      c = ffesrc_strcmp_1ns2i (ffe_case_match (), str, len, *list);
-      goto next;		/* :::::::::::::::::::: */
-
-    case 0:
-      return halfway + 1;
-
-    case 1:
-      offset = (highest_tested - halfway) >> 1;
-      if (offset == 0)
-	goto nope;		/* :::::::::::::::::::: */
-      lowest_tested = halfway;
-      list += offset;
-      halfway += offset;
-      c = ffesrc_strcmp_1ns2i (ffe_case_match (), str, len, *list);
-      goto next;		/* :::::::::::::::::::: */
-
-    default:
-      assert ("unexpected return from ffesrc_strcmp_1ns2i" == NULL);
-      break;
-    }
-
-nope:				/* :::::::::::::::::::: */
-  ffebad_start (FFEBAD_SPEC_VALUE);
-  ffebad_here (0, ffelex_token_where_line (spec->value),
-	       ffelex_token_where_column (spec->value));
-  ffebad_string (whine);
-  ffebad_finish ();
-  return 0;
-}
-
-/* ffestc_subr_format_ -- Return summary of format specifier
-
-   ffestc_subr_format_(&specifier);  */
-
-static ffestvFormat
-ffestc_subr_format_ (ffestpFile *spec)
-{
-  if (!spec->kw_or_val_present)
-    return FFESTV_formatNONE;
-  assert (spec->value_present);
-  if (spec->value_is_label)
-    return FFESTV_formatLABEL;	/* Ok if not a label. */
-
-  assert (spec->value != NULL);
-  if (ffebld_op (spec->u.expr) == FFEBLD_opSTAR)
-    return FFESTV_formatASTERISK;
-
-  if (ffeinfo_kind (ffebld_info (spec->u.expr)) == FFEINFO_kindNAMELIST)
-    return FFESTV_formatNAMELIST;
-
-  if (ffeinfo_rank (ffebld_info (spec->u.expr)) != 0)
-    return FFESTV_formatCHAREXPR;	/* F77 C5. */
-
-  switch (ffeinfo_basictype (ffebld_info (spec->u.expr)))
-    {
-    case FFEINFO_basictypeINTEGER:
-      return FFESTV_formatINTEXPR;
-
-    case FFEINFO_basictypeCHARACTER:
-      return FFESTV_formatCHAREXPR;
-
-    case FFEINFO_basictypeANY:
-      return FFESTV_formatASTERISK;
-
-    default:
-      assert ("bad basictype" == NULL);
-      return FFESTV_formatINTEXPR;
-    }
-}
-
-/* ffestc_subr_is_branch_ -- Handle specifier as branch target label
-
-   ffestc_subr_is_branch_(&specifier);	*/
-
-static bool
-ffestc_subr_is_branch_ (ffestpFile *spec)
-{
-  if (!spec->kw_or_val_present)
-    return TRUE;
-  assert (spec->value_present);
-  assert (spec->value_is_label);
-  spec->value_is_label++;	/* For checking purposes only; 1=>2. */
-  return ffestc_labelref_is_branch_ (spec->value, &spec->u.label);
-}
-
-/* ffestc_subr_is_format_ -- Handle specifier as format target label
-
-   ffestc_subr_is_format_(&specifier);	*/
-
-static bool
-ffestc_subr_is_format_ (ffestpFile *spec)
-{
-  if (!spec->kw_or_val_present)
-    return TRUE;
-  assert (spec->value_present);
-  if (!spec->value_is_label)
-    return TRUE;		/* Ok if not a label. */
-
-  spec->value_is_label++;	/* For checking purposes only; 1=>2. */
-  return ffestc_labelref_is_format_ (spec->value, &spec->u.label);
-}
-
-/* ffestc_subr_is_present_ -- Ensure specifier is present, else error
-
-   ffestc_subr_is_present_("SPECIFIER",&specifier);  */
-
-static bool
-ffestc_subr_is_present_ (const char *name, ffestpFile *spec)
-{
-  if (spec->kw_or_val_present)
-    {
-      assert (spec->value_present);
-      return TRUE;
-    }
-
-  ffebad_start (FFEBAD_MISSING_SPECIFIER);
-  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-	       ffelex_token_where_column (ffesta_tokens[0]));
-  ffebad_string (name);
-  ffebad_finish ();
-  return FALSE;
-}
-
-/* ffestc_subr_speccmp_ -- Compare string to constant expression, if present
-
-   if (ffestc_subr_speccmp_("Constant",&specifier,NULL,NULL) == 0)
-       // specifier value is present and is a char constant "CONSTANT"
-
-   Like strcmp, except the return values are defined as: -1 returned in place
-   of strcmp's generic negative value, 1 in place of it's generic positive
-   value, and 2 when there is no character constant string to compare.	Also,
-   a case-insensitive comparison is performed, where string is assumed to
-   already be in InitialCaps form.
-
-   If a non-NULL pointer is provided as the char **target, then *target is
-   written with NULL if 2 is returned, a pointer to the constant string
-   value of the specifier otherwise.  Similarly, length is written with
-   0 if 2 is returned, the length of the constant string value otherwise.  */
-
-static int
-ffestc_subr_speccmp_ (const char *string, ffestpFile *spec, const char **target,
-		      int *length)
-{
-  ffebldConstant c;
-  int i;
-
-  if (!spec->kw_or_val_present || !spec->value_present
-      || (spec->u.expr == NULL)
-      || (ffebld_op (spec->u.expr) != FFEBLD_opCONTER))
-    {
-      if (target != NULL)
-	*target = NULL;
-      if (length != NULL)
-	*length = 0;
-      return 2;
-    }
-
-  if (ffebld_constant_type (c = ffebld_conter (spec->u.expr))
-      != FFEBLD_constCHARACTERDEFAULT)
-    {
-      if (target != NULL)
-	*target = NULL;
-      if (length != NULL)
-	*length = 0;
-      return 2;
-    }
-
-  if (target != NULL)
-    *target = ffebld_constant_characterdefault (c).text;
-  if (length != NULL)
-    *length = ffebld_constant_characterdefault (c).length;
-
-  i = ffesrc_strcmp_1ns2i (ffe_case_match (),
-			   ffebld_constant_characterdefault (c).text,
-			   ffebld_constant_characterdefault (c).length,
-			   string);
-  if (i == 0)
-    return 0;
-  if (i > 0)
-    return -1;			/* Yes indeed, we reverse the strings to
-				   _strcmpin_.	 */
-  return 1;
-}
-
-/* ffestc_subr_unit_ -- Return summary of unit specifier
-
-   ffestc_subr_unit_(&specifier);  */
-
-static ffestvUnit
-ffestc_subr_unit_ (ffestpFile *spec)
-{
-  if (!spec->kw_or_val_present)
-    return FFESTV_unitNONE;
-  assert (spec->value_present);
-  assert (spec->value != NULL);
-
-  if (ffebld_op (spec->u.expr) == FFEBLD_opSTAR)
-    return FFESTV_unitASTERISK;
-
-  switch (ffeinfo_basictype (ffebld_info (spec->u.expr)))
-    {
-    case FFEINFO_basictypeINTEGER:
-      return FFESTV_unitINTEXPR;
-
-    case FFEINFO_basictypeCHARACTER:
-      return FFESTV_unitCHAREXPR;
-
-    case FFEINFO_basictypeANY:
-      return FFESTV_unitASTERISK;
-
-    default:
-      assert ("bad basictype" == NULL);
-      return FFESTV_unitINTEXPR;
-    }
-}
-
-/* Call this function whenever it's possible that one or more top
-   stack items are label-targeting DO blocks that have had their
-   labels defined, but at a time when they weren't at the top of the
-   stack.  This prevents uninformative diagnostics for programs
-   like "DO 10", "IF (...) THEN", "10 ELSE", "END IF", "END".  */
-
-static void
-ffestc_try_shriek_do_ (void)
-{
-  ffelab lab;
-  ffelabType ty;
-
-  while ((ffestw_state (ffestw_stack_top ()) == FFESTV_stateDO)
-	 && ((lab = (ffestw_label (ffestw_stack_top ()))) != NULL)
-	 && (((ty = (ffelab_type (lab)))
-	      == FFELAB_typeANY)
-	     || (ty == FFELAB_typeUSELESS)
-	     || (ty == FFELAB_typeFORMAT)
-	     || (ty == FFELAB_typeNOTLOOP)
-	     || (ty == FFELAB_typeENDIF)))
-    ffestc_shriek_do_ (FALSE);
-}
-
-/* ffestc_decl_start -- R426 or R501
-
-   ffestc_decl_start(...);
-
-   Verify that R426 component-def-stmt or R501 type-declaration-stmt are
-   valid here, figure out which one, and implement.  */
-
-void
-ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind,
-		   ffelexToken kindt, ffebld len, ffelexToken lent)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-    case FFESTV_statePROGRAM0:
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateMODULE0:
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_statePROGRAM1:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateMODULE1:
-    case FFESTV_stateBLOCKDATA1:
-    case FFESTV_statePROGRAM2:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateMODULE2:
-    case FFESTV_stateBLOCKDATA2:
-    case FFESTV_statePROGRAM3:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateMODULE3:
-    case FFESTV_stateBLOCKDATA3:
-    case FFESTV_stateUSE:
-      ffestc_local_.decl.is_R426 = 2;
-      break;
-
-    case FFESTV_stateTYPE:
-    case FFESTV_stateSTRUCTURE:
-    case FFESTV_stateMAP:
-      ffestc_local_.decl.is_R426 = 1;
-      break;
-
-    default:
-      ffestc_order_bad_ ();
-      ffestc_labeldef_useless_ ();
-      ffestc_local_.decl.is_R426 = 0;
-      return;
-    }
-
-  switch (ffestc_local_.decl.is_R426)
-    {
-    case 2:
-      ffestc_R501_start (type, typet, kind, kindt, len, lent);
-      break;
-
-    default:
-      ffestc_labeldef_useless_ ();
-      break;
-    }
-}
-
-/* ffestc_decl_attrib -- R426 or R501 type attribute
-
-   ffestc_decl_attrib(...);
-
-   Verify that R426 component-def-stmt or R501 type-declaration-stmt attribute
-   is valid here and implement.	 */
-
-void
-ffestc_decl_attrib (ffestpAttrib attrib UNUSED,
-		    ffelexToken attribt UNUSED,
-		    ffestrOther intent_kw UNUSED,
-		    ffesttDimList dims UNUSED)
-{
-  ffebad_start (FFEBAD_F90);
-  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-	       ffelex_token_where_column (ffesta_tokens[0]));
-  ffebad_finish ();
-  return;
-}
-
-/* ffestc_decl_item -- R426 or R501
-
-   ffestc_decl_item(...);
-
-   Establish type for a particular object.  */
-
-void
-ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt,
-	      ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
-		  ffelexToken initt, bool clist)
-{
-  switch (ffestc_local_.decl.is_R426)
-    {
-    case 2:
-      ffestc_R501_item (name, kind, kindt, dims, len, lent, init, initt,
-			clist);
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* ffestc_decl_itemstartvals -- R426 or R501 start list of values
-
-   ffestc_decl_itemstartvals();
-
-   Gonna specify values for the object now.  */
-
-void
-ffestc_decl_itemstartvals (void)
-{
-  switch (ffestc_local_.decl.is_R426)
-    {
-    case 2:
-      ffestc_R501_itemstartvals ();
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* ffestc_decl_itemvalue -- R426 or R501 source value
-
-   ffestc_decl_itemvalue(repeat,repeat_token,value,value_token);
-
-   Make sure repeat and value are valid for the object being initialized.  */
-
-void
-ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token,
-		       ffebld value, ffelexToken value_token)
-{
-  switch (ffestc_local_.decl.is_R426)
-    {
-    case 2:
-      ffestc_R501_itemvalue (repeat, repeat_token, value, value_token);
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* ffestc_decl_itemendvals -- R426 or R501 end list of values
-
-   ffelexToken t;  // the SLASH token that ends the list.
-   ffestc_decl_itemendvals(t);
-
-   No more values, might specify more objects now.  */
-
-void
-ffestc_decl_itemendvals (ffelexToken t)
-{
-  switch (ffestc_local_.decl.is_R426)
-    {
-    case 2:
-      ffestc_R501_itemendvals (t);
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* ffestc_decl_finish -- R426 or R501
-
-   ffestc_decl_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_decl_finish (void)
-{
-  switch (ffestc_local_.decl.is_R426)
-    {
-    case 2:
-      ffestc_R501_finish ();
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* ffestc_elsewhere -- Generic ELSE WHERE statement
-
-   ffestc_end();
-
-   Decide whether ELSEWHERE or ELSE w/if-construct-name=="WHERE" is meant.  */
-
-void
-ffestc_elsewhere (ffelexToken where)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateIFTHEN:
-      ffestc_R805 (where);
-      break;
-
-    default:
-      break;
-    }
-}
-
-/* ffestc_end -- Generic END statement
-
-   ffestc_end();
-
-   Make sure a generic END is valid in the current context, and implement
-   it.	*/
-
-void
-ffestc_end (void)
-{
-  ffestw b;
-
-  b = ffestw_stack_top ();
-
-recurse:
-
-  switch (ffestw_state (b))
-    {
-    case FFESTV_stateBLOCKDATA0:
-    case FFESTV_stateBLOCKDATA1:
-    case FFESTV_stateBLOCKDATA2:
-    case FFESTV_stateBLOCKDATA3:
-    case FFESTV_stateBLOCKDATA4:
-    case FFESTV_stateBLOCKDATA5:
-      ffestc_R1112 (NULL);
-      break;
-
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateFUNCTION4:
-    case FFESTV_stateFUNCTION5:
-      if ((ffestw_state (ffestw_previous (b)) != FFESTV_stateNIL)
-	  && (ffestw_state (ffestw_previous (b)) != FFESTV_stateINTERFACE0))
-	{
-	  ffebad_start (FFEBAD_END_WO);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_here (1, ffestw_line (ffestw_previous (b)), ffestw_col (ffestw_previous (b)));
-	  ffebad_string ("FUNCTION");
-	  ffebad_finish ();
-	}
-      ffestc_R1221 (NULL);
-      break;
-
-    case FFESTV_stateMODULE0:
-    case FFESTV_stateMODULE1:
-    case FFESTV_stateMODULE2:
-    case FFESTV_stateMODULE3:
-    case FFESTV_stateMODULE4:
-    case FFESTV_stateMODULE5:
-      break;
-
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateSUBROUTINE5:
-      if ((ffestw_state (ffestw_previous (b)) != FFESTV_stateNIL)
-	  && (ffestw_state (ffestw_previous (b)) != FFESTV_stateINTERFACE0))
-	{
-	  ffebad_start (FFEBAD_END_WO);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_here (1, ffestw_line (ffestw_previous (b)), ffestw_col (ffestw_previous (b)));
-	  ffebad_string ("SUBROUTINE");
-	  ffebad_finish ();
-	}
-      ffestc_R1225 (NULL);
-      break;
-
-    case FFESTV_stateUSE:
-      b = ffestw_previous (ffestw_stack_top ());
-      goto recurse;		/* :::::::::::::::::::: */
-
-    default:
-      ffestc_R1103 (NULL);
-      break;
-    }
-}
-
-/* ffestc_eof -- Generic EOF
-
-   ffestc_eof();
-
-   Make sure we're at state NIL, or issue an error message and use each
-   block's shriek function to clean up to state NIL.  */
-
-void
-ffestc_eof (void)
-{
-  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL)
-    {
-      ffebad_start (FFEBAD_EOF_BEFORE_BLOCK_END);
-      ffebad_here (0, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-      ffebad_finish ();
-      do
-	(*ffestw_shriek (ffestw_stack_top ()))(FALSE);
-      while (ffestw_state (ffestw_stack_top ()) != FFESTV_stateNIL);
-    }
-}
-
-/* ffestc_exec_transition -- Check if ok and move stmt state to executable
-
-   if (ffestc_exec_transition())
-       // Transition successful (kind of like a CONTINUE stmt was seen).
-
-   If the current statement state is a non-nested specification state in
-   which, say, a CONTINUE statement would be valid, then enter the state
-   we'd be in after seeing CONTINUE (without, of course, generating any
-   CONTINUE code), call ffestd_exec_begin, and return TRUE.  Otherwise
-   return FALSE.
-
-   This function cannot be invoked once the first executable statement
-   is seen.  This function may choose to always return TRUE by shrieking
-   away any interceding state stack entries to reach the base level of
-   specification state, but right now it doesn't, and it is (or should
-   be) purely an issue of how one wishes errors to be handled (for example,
-   an unrecognized statement in the middle of a STRUCTURE construct: after
-   the error message, should subsequent statements still be interpreted as
-   being within the construct, or should the construct be terminated upon
-   seeing the unrecognized statement?  we do the former at the moment).  */
-
-bool
-ffestc_exec_transition (void)
-{
-  bool update;
-
-recurse:
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-      ffestc_shriek_begin_program_ ();
-      goto recurse;		/* :::::::::::::::::::: */
-
-    case FFESTV_statePROGRAM0:
-    case FFESTV_stateSUBROUTINE0:
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateBLOCKDATA0:
-      ffestw_state (ffestw_stack_top ()) += 4;	/* To state UNIT4. */
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM1:
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateBLOCKDATA1:
-      ffestw_state (ffestw_stack_top ()) += 3;	/* To state UNIT4. */
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM2:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateBLOCKDATA2:
-      ffestw_state (ffestw_stack_top ()) += 2;	/* To state UNIT4. */
-      update = TRUE;
-      break;
-
-    case FFESTV_statePROGRAM3:
-    case FFESTV_stateSUBROUTINE3:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateBLOCKDATA3:
-      ffestw_state (ffestw_stack_top ()) += 1;	/* To state UNIT4. */
-      update = TRUE;
-      break;
-
-    case FFESTV_stateUSE:
-      goto recurse;		/* :::::::::::::::::::: */
-
-    default:
-      return FALSE;
-    }
-
-  if (update)
-    ffestw_update (NULL);	/* Update state line/col info. */
-
-  ffesta_seen_first_exec = TRUE;
-  ffestd_exec_begin ();
-
-  return TRUE;
-}
-
-/* ffestc_ffebad_here_doiter -- Calls ffebad_here with ptr to DO iter var
-
-   ffesymbol s;
-   // call ffebad_start first, of course.
-   ffestc_ffebad_here_doiter(0,s);
-   // call ffebad_finish afterwards, naturally.
-
-   Searches the stack of blocks backwards for a DO loop that has s
-   as its iteration variable, then calls ffebad_here with pointers to
-   that particular reference to the variable.  Crashes if the DO loop
-   can't be found.  */
-
-void
-ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s)
-{
-  ffestw block;
-
-  for (block = ffestw_top_do (ffestw_stack_top ());
-       (block != NULL) && (ffestw_blocknum (block) != 0);
-       block = ffestw_top_do (ffestw_previous (block)))
-    {
-      if (ffestw_do_iter_var (block) == s)
-	{
-	  ffebad_here (i, ffelex_token_where_line (ffestw_do_iter_var_t (block)),
-		  ffelex_token_where_column (ffestw_do_iter_var_t (block)));
-	  return;
-	}
-    }
-  assert ("no do block found" == NULL);
-}
-
-/* ffestc_is_decl_not_R1219 -- Context information for FFESTB
-
-   if (ffestc_is_decl_not_R1219()) ...
-
-   When a statement with the form "type[RECURSIVE]FUNCTIONname(name-list)"
-   is seen, call this function.	 It returns TRUE if the statement's context
-   is such that it is a declaration of an object named
-   "[RECURSIVE]FUNCTIONname" with an array-decl spec of "name-list", FALSE
-   if the statement's context is such that it begins the definition of a
-   function named "name" havin the dummy argument list "name-list" (this
-   is the R1219 function-stmt case).  */
-
-bool
-ffestc_is_decl_not_R1219 (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateNIL:
-    case FFESTV_statePROGRAM5:
-    case FFESTV_stateSUBROUTINE5:
-    case FFESTV_stateFUNCTION5:
-    case FFESTV_stateMODULE5:
-    case FFESTV_stateINTERFACE0:
-      return FALSE;
-
-    default:
-      return TRUE;
-    }
-}
-
-/* ffestc_is_entry_in_subr -- Context information for FFESTB
-
-   if (ffestc_is_entry_in_subr()) ...
-
-   When a statement with the form "ENTRY name(name-list)"
-   is seen, call this function.	 It returns TRUE if the statement's context
-   is such that it may have "*", meaning alternate return, in place of
-   names in the name list (i.e. if the ENTRY is in a subroutine context).
-   It also returns TRUE if the ENTRY is not in a function context (invalid
-   but prevents extra complaints about "*", if present).  It returns FALSE
-   if the ENTRY is in a function context.  */
-
-bool
-ffestc_is_entry_in_subr (void)
-{
-  ffestvState s;
-
-  s = ffestw_state (ffestw_stack_top ());
-
-recurse:
-
-  switch (s)
-    {
-    case FFESTV_stateFUNCTION0:
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-    case FFESTV_stateFUNCTION4:
-      return FALSE;
-
-    case FFESTV_stateUSE:
-      s = ffestw_state (ffestw_previous (ffestw_stack_top ()));
-      goto recurse;		/* :::::::::::::::::::: */
-
-    default:
-      return TRUE;
-    }
-}
-
-/* ffestc_is_let_not_V027 -- Context information for FFESTB
-
-   if (ffestc_is_let_not_V027()) ...
-
-   When a statement with the form "PARAMETERname=expr"
-   is seen, call this function.	 It returns TRUE if the statement's context
-   is such that it is an assignment to an object named "PARAMETERname", FALSE
-   if the statement's context is such that it is a V-extension PARAMETER
-   statement that is like a PARAMETER(name=expr) statement except that the
-   type of name is determined by the type of expr, not the implicit or
-   explicit typing of name.  */
-
-bool
-ffestc_is_let_not_V027 (void)
-{
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_statePROGRAM4:
-    case FFESTV_stateSUBROUTINE4:
-    case FFESTV_stateFUNCTION4:
-    case FFESTV_stateWHERETHEN:
-    case FFESTV_stateIFTHEN:
-    case FFESTV_stateDO:
-    case FFESTV_stateSELECT0:
-    case FFESTV_stateSELECT1:
-    case FFESTV_stateWHERE:
-    case FFESTV_stateIF:
-      return TRUE;
-
-    default:
-      return FALSE;
-    }
-}
-
-/* ffestc_terminate_4 -- Terminate ffestc after scoping unit
-
-   ffestc_terminate_4();
-
-   For SUBROUTINEs/FUNCTIONs within INTERFACE/END INTERFACE, derived-TYPE-
-   defs, and statement function defs.  */
-
-void
-ffestc_terminate_4 (void)
-{
-  ffestc_entry_num_ = ffestc_saved_entry_num_;
-}
-
-/* ffestc_R501_start -- type-declaration-stmt
-
-   ffestc_R501_start(...);
-
-   Verify that R501 type-declaration-stmt is
-   valid here and implement.  */
-
-void
-ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
-		   ffelexToken kindt, ffebld len, ffelexToken lent)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_typedecl_ () != FFESTC_orderOK_)
-    {
-      ffestc_local_.decl.is_R426 = 0;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestc_establish_declstmt_ (type, typet, kind, kindt, len, lent);
-}
-
-/* ffestc_R501_attrib -- type attribute
-
-   ffestc_R501_attrib(...);
-
-   Verify that R501 type-declaration-stmt attribute
-   is valid here and implement.	 */
-
-void
-ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
-		    ffestrOther intent_kw UNUSED,
-		    ffesttDimList dims UNUSED)
-{
-  ffestc_check_attrib_ ();
-
-  switch (attrib)
-    {
-    case FFESTP_attribDIMENSION:
-      ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-      break;
-
-    case FFESTP_attribEXTERNAL:
-      break;
-
-    case FFESTP_attribINTRINSIC:
-      break;
-
-    case FFESTP_attribPARAMETER:
-      break;
-
-    case FFESTP_attribSAVE:
-      switch (ffestv_save_state_)
-	{
-	case FFESTV_savestateNONE:
-	  ffestv_save_state_ = FFESTV_savestateSPECIFIC;
-	  ffestv_save_line_
-	    = ffewhere_line_use (ffelex_token_where_line (attribt));
-	  ffestv_save_col_
-	    = ffewhere_column_use (ffelex_token_where_column (attribt));
-	  break;
-
-	case FFESTV_savestateSPECIFIC:
-	case FFESTV_savestateANY:
-	  break;
-
-	case FFESTV_savestateALL:
-	  if (ffe_is_pedantic ())
-	    {
-	      ffebad_start (FFEBAD_CONFLICTING_SAVES);
-	      ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
-	      ffebad_here (1, ffelex_token_where_line (attribt),
-			   ffelex_token_where_column (attribt));
-	      ffebad_finish ();
-	    }
-	  ffestv_save_state_ = FFESTV_savestateANY;
-	  break;
-
-	default:
-	  assert ("unexpected save state" == NULL);
-	  break;
-	}
-      break;
-
-    default:
-      assert ("unexpected attribute" == NULL);
-      break;
-    }
-}
-
-/* ffestc_R501_item -- declared object
-
-   ffestc_R501_item(...);
-
-   Establish type for a particular object.  */
-
-void
-ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt,
-		  ffesttDimList dims, ffebld len, ffelexToken lent,
-		  ffebld init, ffelexToken initt, bool clist)
-{
-  ffesymbol s;
-  ffesymbol sfn;		/* FUNCTION symbol. */
-  ffebld array_size;
-  ffebld extents;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffestpDimtype nd;
-  bool is_init = (init != NULL) || clist;
-  bool is_assumed;
-  bool is_ugly_assumed;
-  ffeinfoRank rank;
-
-  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. */
-
-  ffestc_establish_declinfo_ (kind, kindt, len, lent);
-
-  is_assumed = (ffestc_local_.decl.basic_type == FFEINFO_basictypeCHARACTER)
-    && (ffestc_local_.decl.size == FFETARGET_charactersizeNONE);
-
-  if ((dims != NULL) || is_init)
-    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  s = ffesymbol_declare_local (name, TRUE);
-  sa = ffesymbol_attrs (s);
-
-  /* First figure out what kind of object this is based solely on the current
-     object situation (type params, dimension list, and initialization). */
-
-  na = FFESYMBOL_attrsTYPE;
-
-  if (is_assumed)
-    na |= FFESYMBOL_attrsANYLEN;
-
-  is_ugly_assumed = (ffe_is_ugly_assumed ()
-		     && ((sa & FFESYMBOL_attrsDUMMY)
-			 || (ffesymbol_where (s) == FFEINFO_whereDUMMY)));
-
-  nd = ffestt_dimlist_type (dims, is_ugly_assumed);
-  switch (nd)
-    {
-    case FFESTP_dimtypeNONE:
-      break;
-
-    case FFESTP_dimtypeKNOWN:
-      na |= FFESYMBOL_attrsARRAY;
-      break;
-
-    case FFESTP_dimtypeADJUSTABLE:
-      na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE;
-      break;
-
-    case FFESTP_dimtypeASSUMED:
-      na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsANYSIZE;
-      break;
-
-    case FFESTP_dimtypeADJUSTABLEASSUMED:
-      na |= FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE
-	| FFESYMBOL_attrsANYSIZE;
-      break;
-
-    default:
-      assert ("unexpected dimtype" == NULL);
-      na = FFESYMBOL_attrsetNONE;
-      break;
-    }
-
-  if (!ffesta_is_entry_valid
-      && (((na & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsARRAY))
-	   == (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsARRAY))))
-    na = FFESYMBOL_attrsetNONE;
-
-  if (is_init)
-    {
-      if (na == FFESYMBOL_attrsetNONE)
-	;
-      else if (na & (FFESYMBOL_attrsANYLEN
-		     | FFESYMBOL_attrsADJUSTABLE
-		     | FFESYMBOL_attrsANYSIZE))
-	na = FFESYMBOL_attrsetNONE;
-      else
-	na |= FFESYMBOL_attrsINIT;
-    }
-
-  /* Now figure out what kind of object we've got based on previous
-     declarations of or references to the object. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ;
-  else if (!ffesymbol_is_specable (s)
-	   && (((ffesymbol_where (s) != FFEINFO_whereCONSTANT)
-		&& (ffesymbol_where (s) != FFEINFO_whereINTRINSIC))
-	       || (na & (FFESYMBOL_attrsARRAY | FFESYMBOL_attrsINIT))))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef, and can't
-				   dimension/init UNDERSTOODs. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = sa;
-  else if ((sa & na)
-	   || ((sa & (FFESYMBOL_attrsSFARG
-		      | FFESYMBOL_attrsADJUSTS))
-	       && (na & (FFESYMBOL_attrsARRAY
-			 | FFESYMBOL_attrsANYLEN)))
-	   || ((sa & FFESYMBOL_attrsRESULT)
-	       && (na & (FFESYMBOL_attrsARRAY
-			 | FFESYMBOL_attrsINIT)))
-	   || ((sa & (FFESYMBOL_attrsSFUNC
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsINTRINSIC
-		      | FFESYMBOL_attrsINIT))
-	       && (na & (FFESYMBOL_attrsARRAY
-			 | FFESYMBOL_attrsANYLEN
-			 | FFESYMBOL_attrsINIT)))
-	   || ((sa & FFESYMBOL_attrsARRAY)
-	       && !ffesta_is_entry_valid
-	       && (na & FFESYMBOL_attrsANYLEN))
-	   || ((sa & (FFESYMBOL_attrsADJUSTABLE
-		      | FFESYMBOL_attrsANYLEN
-		      | FFESYMBOL_attrsANYSIZE
-		      | FFESYMBOL_attrsDUMMY))
-	       && (na & FFESYMBOL_attrsINIT))
-	   || ((sa & (FFESYMBOL_attrsSAVE
-		      | FFESYMBOL_attrsNAMELIST
-		      | FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsEQUIV))
-	       && (na & (FFESYMBOL_attrsADJUSTABLE
-			 | FFESYMBOL_attrsANYLEN
-			 | FFESYMBOL_attrsANYSIZE))))
-    na = FFESYMBOL_attrsetNONE;
-  else if ((ffesymbol_kind (s) == FFEINFO_kindENTITY)
-	   && (ffesymbol_where (s) == FFEINFO_whereCONSTANT)
-	   && (na & FFESYMBOL_attrsANYLEN))
-    {				/* If CHARACTER*(*) FOO after PARAMETER FOO. */
-      na |= FFESYMBOL_attrsTYPE;
-      ffestc_local_.decl.size = ffebld_size (ffesymbol_init (s));
-    }
-  else
-    na |= sa;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    {
-      ffesymbol_error (s, name);
-      ffestc_parent_ok_ = FALSE;
-    }
-  else if (na & FFESYMBOL_attrsANY)
-    ffestc_parent_ok_ = FALSE;
-  else
-    {
-      ffesymbol_set_attrs (s, na);
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      rank = ffesymbol_rank (s);
-      if (dims != NULL)
-	{
-	  ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
-							 &array_size,
-							 &extents,
-							 is_ugly_assumed));
-	  ffesymbol_set_arraysize (s, array_size);
-	  ffesymbol_set_extents (s, extents);
-	  if (!(0 && ffe_is_90 ())
-	      && (ffebld_op (array_size) == FFEBLD_opCONTER)
-	      && (ffebld_constant_integerdefault (ffebld_conter (array_size))
-		  == 0))
-	    {
-	      ffebad_start (FFEBAD_ZERO_ARRAY);
-	      ffebad_here (0, ffelex_token_where_line (name),
-			   ffelex_token_where_column (name));
-	      ffebad_finish ();
-	    }
-	}
-      if (init != NULL)
-	{
-	  ffesymbol_set_init (s,
-			      ffeexpr_convert (init, initt, name,
-					       ffestc_local_.decl.basic_type,
-					       ffestc_local_.decl.kind_type,
-					       rank,
-					       ffestc_local_.decl.size,
-					       FFEEXPR_contextDATA));
-	  ffecom_notify_init_symbol (s);
-	  ffesymbol_update_init (s);
-#if FFEGLOBAL_ENABLED
-	  if (ffesymbol_common (s) != NULL)
-	    ffeglobal_init_common (ffesymbol_common (s), initt);
-#endif
-	}
-      else if (clist)
-	{
-	  ffebld symter;
-
-	  symter = ffebld_new_symter (s, FFEINTRIN_genNONE,
-				      FFEINTRIN_specNONE,
-				      FFEINTRIN_impNONE);
-
-	  ffebld_set_info (symter,
-			   ffeinfo_new (ffestc_local_.decl.basic_type,
-					ffestc_local_.decl.kind_type,
-					rank,
-					FFEINFO_kindNONE,
-					FFEINFO_whereNONE,
-					ffestc_local_.decl.size));
-	  ffestc_local_.decl.initlist = ffebld_new_item (symter, NULL);
-	}
-      if (ffesymbol_basictype (s) == FFEINFO_basictypeNONE)
-	{
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (ffestc_local_.decl.basic_type,
-					   ffestc_local_.decl.kind_type,
-					   rank,
-					   ffesymbol_kind (s),
-					   ffesymbol_where (s),
-					   ffestc_local_.decl.size));
-	  if ((na & FFESYMBOL_attrsRESULT)
-	      && ((sfn = ffesymbol_funcresult (s)) != NULL))
-	    {
-	      ffesymbol_set_info (sfn,
-				  ffeinfo_new (ffestc_local_.decl.basic_type,
-					       ffestc_local_.decl.kind_type,
-					       rank,
-					       ffesymbol_kind (sfn),
-					       ffesymbol_where (sfn),
-					       ffestc_local_.decl.size));
-	      ffesymbol_signal_unreported (sfn);
-	    }
-	}
-      else if ((ffestc_local_.decl.basic_type != ffesymbol_basictype (s))
-	       || (ffestc_local_.decl.kind_type != ffesymbol_kindtype (s))
-	       || ((ffestc_local_.decl.basic_type
-		    == FFEINFO_basictypeCHARACTER)
-		   && (ffestc_local_.decl.size != ffesymbol_size (s))))
-	{			/* Explicit type disagrees with established
-				   implicit type. */
-	  ffesymbol_error (s, name);
-	}
-
-      if ((na & FFESYMBOL_attrsADJUSTS)
-	  && ((ffestc_local_.decl.basic_type != FFEINFO_basictypeINTEGER)
-	      || (ffestc_local_.decl.kind_type != FFEINFO_kindtypeINTEGER1)))
-	ffesymbol_error (s, name);
-
-      ffesymbol_signal_unreported (s);
-      ffestc_parent_ok_ = TRUE;
-    }
-}
-
-/* ffestc_R501_itemstartvals -- Start list of values
-
-   ffestc_R501_itemstartvals();
-
-   Gonna specify values for the object now.  */
-
-void
-ffestc_R501_itemstartvals (void)
-{
-  ffestc_check_item_startvals_ ();
-
-  if (ffestc_parent_ok_)
-    ffedata_begin (ffestc_local_.decl.initlist);
-}
-
-/* ffestc_R501_itemvalue -- Source value
-
-   ffestc_R501_itemvalue(repeat,repeat_token,value,value_token);
-
-   Make sure repeat and value are valid for the object being initialized.  */
-
-void
-ffestc_R501_itemvalue (ffebld repeat, ffelexToken repeat_token,
-		       ffebld value, ffelexToken value_token)
-{
-  ffetargetIntegerDefault rpt;
-
-  ffestc_check_item_value_ ();
-
-  if (!ffestc_parent_ok_)
-    return;
-
-  if (repeat == NULL)
-    rpt = 1;
-  else if (ffebld_op (repeat) == FFEBLD_opCONTER)
-    rpt = ffebld_constant_integerdefault (ffebld_conter (repeat));
-  else
-    {
-      ffestc_parent_ok_ = FALSE;
-      ffedata_end (TRUE, NULL);
-      return;
-    }
-
-  if (!(ffestc_parent_ok_ = ffedata_value (rpt, value,
-		      (repeat_token == NULL) ? value_token : repeat_token)))
-    ffedata_end (TRUE, NULL);
-}
-
-/* ffestc_R501_itemendvals -- End list of values
-
-   ffelexToken t;  // the SLASH token that ends the list.
-   ffestc_R501_itemendvals(t);
-
-   No more values, might specify more objects now.  */
-
-void
-ffestc_R501_itemendvals (ffelexToken t)
-{
-  ffestc_check_item_endvals_ ();
-
-  if (ffestc_parent_ok_)
-    ffestc_parent_ok_ = ffedata_end (FALSE, t);
-
-  if (ffestc_parent_ok_)
-    ffesymbol_signal_unreported (ffebld_symter (ffebld_head
-					     (ffestc_local_.decl.initlist)));
-}
-
-/* ffestc_R501_finish -- Done
-
-   ffestc_R501_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R501_finish (void)
-{
-  ffestc_check_finish_ ();
-}
-
-/* ffestc_R522 -- SAVE statement with no list
-
-   ffestc_R522();
-
-   Verify that SAVE is valid here, and flag everything as SAVEd.  */
-
-void
-ffestc_R522 (void)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  switch (ffestv_save_state_)
-    {
-    case FFESTV_savestateNONE:
-      ffestv_save_state_ = FFESTV_savestateALL;
-      ffestv_save_line_
-	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
-      ffestv_save_col_
-	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
-      break;
-
-    case FFESTV_savestateANY:
-      break;
-
-    case FFESTV_savestateSPECIFIC:
-    case FFESTV_savestateALL:
-      if (ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_CONFLICTING_SAVES);
-	  ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
-	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_finish ();
-	}
-      ffestv_save_state_ = FFESTV_savestateALL;
-      break;
-
-    default:
-      assert ("unexpected save state" == NULL);
-      break;
-    }
-
-  ffe_set_is_saveall (TRUE);
-
-  ffestd_R522 ();
-}
-
-/* ffestc_R522start -- SAVE statement list begin
-
-   ffestc_R522start();
-
-   Verify that SAVE is valid here, and begin accepting items in the list.  */
-
-void
-ffestc_R522start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  switch (ffestv_save_state_)
-    {
-    case FFESTV_savestateNONE:
-      ffestv_save_state_ = FFESTV_savestateSPECIFIC;
-      ffestv_save_line_
-	= ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
-      ffestv_save_col_
-	= ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
-      break;
-
-    case FFESTV_savestateSPECIFIC:
-    case FFESTV_savestateANY:
-      break;
-
-    case FFESTV_savestateALL:
-      if (ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_CONFLICTING_SAVES);
-	  ffebad_here (0, ffestv_save_line_, ffestv_save_col_);
-	  ffebad_here (1, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_finish ();
-	}
-      ffestv_save_state_ = FFESTV_savestateANY;
-      break;
-
-    default:
-      assert ("unexpected save state" == NULL);
-      break;
-    }
-
-  ffestd_R522start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R522item_object -- SAVE statement for object-name
-
-   ffestc_R522item_object(name_token);
-
-   Make sure name_token identifies a valid object to be SAVEd.	*/
-
-void
-ffestc_R522item_object (ffelexToken name)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  s = ffesymbol_declare_local (name, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s)
-      && ((ffesymbol_kind (s) != FFEINFO_kindENTITY)
-	  || (ffesymbol_where (s) != FFEINFO_whereLOCAL)))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = sa;
-  else if (!(sa & ~(FFESYMBOL_attrsARRAY
-		    | FFESYMBOL_attrsEQUIV
-		    | FFESYMBOL_attrsINIT
-		    | FFESYMBOL_attrsNAMELIST
-		    | FFESYMBOL_attrsSFARG
-		    | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsSAVE;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, name);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_update_save (s);
-      ffesymbol_signal_unreported (s);
-    }
-
-  ffestd_R522item_object (name);
-}
-
-/* ffestc_R522item_cblock -- SAVE statement for common-block-name
-
-   ffestc_R522item_cblock(name_token);
-
-   Make sure name_token identifies a valid common block to be SAVEd.  */
-
-void
-ffestc_R522item_cblock (ffelexToken name)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  s = ffesymbol_declare_cblock (name, ffelex_token_where_line (ffesta_tokens[0]),
-			      ffelex_token_where_column (ffesta_tokens[0]));
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;
-  else if (sa & FFESYMBOL_attrsANY)
-    na = sa;			/* Already have an error here, say nothing. */
-  else if (!(sa & ~(FFESYMBOL_attrsCBLOCK)))
-    na = sa | FFESYMBOL_attrsSAVECBLOCK;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, (name == NULL) ? ffesta_tokens[0] : name);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_update_save (s);
-      ffesymbol_signal_unreported (s);
-    }
-
-  ffestd_R522item_cblock (name);
-}
-
-/* ffestc_R522finish -- SAVE statement list complete
-
-   ffestc_R522finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R522finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R522finish ();
-}
-
-/* ffestc_R524_start -- DIMENSION statement list begin
-
-   ffestc_R524_start(bool virtual);
-
-   Verify that DIMENSION is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R524_start (bool virtual)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestd_R524_start (virtual);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R524_item -- DIMENSION statement for object-name
-
-   ffestc_R524_item(name_token,dim_list);
-
-   Make sure name_token identifies a valid object to be DIMENSIONd.  */
-
-void
-ffestc_R524_item (ffelexToken name, ffesttDimList dims)
-{
-  ffesymbol s;
-  ffebld array_size;
-  ffebld extents;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffestpDimtype nd;
-  ffeinfoRank rank;
-  bool is_ugly_assumed;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  assert (dims != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  s = ffesymbol_declare_local (name, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* First figure out what kind of object this is based solely on the current
-     object situation (dimension list). */
-
-  is_ugly_assumed = (ffe_is_ugly_assumed ()
-		     && ((sa & FFESYMBOL_attrsDUMMY)
-			 || (ffesymbol_where (s) == FFEINFO_whereDUMMY)));
-
-  nd = ffestt_dimlist_type (dims, is_ugly_assumed);
-  switch (nd)
-    {
-    case FFESTP_dimtypeKNOWN:
-      na = FFESYMBOL_attrsARRAY;
-      break;
-
-    case FFESTP_dimtypeADJUSTABLE:
-      na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE;
-      break;
-
-    case FFESTP_dimtypeASSUMED:
-      na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsANYSIZE;
-      break;
-
-    case FFESTP_dimtypeADJUSTABLEASSUMED:
-      na = FFESYMBOL_attrsARRAY | FFESYMBOL_attrsADJUSTABLE
-	| FFESYMBOL_attrsANYSIZE;
-      break;
-
-    default:
-      assert ("Unexpected dims type" == NULL);
-      na = FFESYMBOL_attrsetNONE;
-      break;
-    }
-
-  /* Now figure out what kind of object we've got based on previous
-     declarations of or references to the object. */
-
-  if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;
-  else if (!ffesta_is_entry_valid
-	   && (sa & FFESYMBOL_attrsANYLEN))
-    na = FFESYMBOL_attrsetNONE;
-  else if ((sa & FFESYMBOL_attrsARRAY)
-	   || ((sa & (FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsEQUIV
-		      | FFESYMBOL_attrsNAMELIST
-		      | FFESYMBOL_attrsSAVE))
-	       && (na & (FFESYMBOL_attrsADJUSTABLE
-			 | FFESYMBOL_attrsANYSIZE))))
-    na = FFESYMBOL_attrsetNONE;
-  else if (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
-		    | FFESYMBOL_attrsANYLEN
-		    | FFESYMBOL_attrsANYSIZE
-		    | FFESYMBOL_attrsCOMMON
-		    | FFESYMBOL_attrsDUMMY
-		    | FFESYMBOL_attrsEQUIV
-		    | FFESYMBOL_attrsNAMELIST
-		    | FFESYMBOL_attrsSAVE
-		    | FFESYMBOL_attrsTYPE)))
-    na |= sa;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, name);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
-						     &array_size,
-						     &extents,
-						     is_ugly_assumed));
-      ffesymbol_set_arraysize (s, array_size);
-      ffesymbol_set_extents (s, extents);
-      if (!(0 && ffe_is_90 ())
-	  && (ffebld_op (array_size) == FFEBLD_opCONTER)
-	  && (ffebld_constant_integerdefault (ffebld_conter (array_size))
-	      == 0))
-	{
-	  ffebad_start (FFEBAD_ZERO_ARRAY);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_finish ();
-	}
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       rank,
-				       ffesymbol_kind (s),
-				       ffesymbol_where (s),
-				       ffesymbol_size (s)));
-    }
-
-  ffesymbol_signal_unreported (s);
-
-  ffestd_R524_item (name, dims);
-}
-
-/* ffestc_R524_finish -- DIMENSION statement list complete
-
-   ffestc_R524_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R524_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R524_finish ();
-}
-
-/* ffestc_R528_start -- DATA statement list begin
-
-   ffestc_R528_start();
-
-   Verify that DATA is valid here, and begin accepting items in the list.  */
-
-void
-ffestc_R528_start (void)
-{
-  ffestcOrder_ order;
-
-  ffestc_check_start_ ();
-  if (ffe_is_pedantic_not_90 ())
-    order = ffestc_order_data77_ ();
-  else
-    order = ffestc_order_data_ ();
-  if (order != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-#if 1
-  ffestc_local_.data.objlist = NULL;
-#else
-  ffestd_R528_start_ ();
-#endif
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R528_item_object -- DATA statement target object
-
-   ffestc_R528_item_object(object,object_token);
-
-   Make sure object is valid to be DATAd.  */
-
-void
-ffestc_R528_item_object (ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-#if 1
-  if (ffestc_local_.data.objlist == NULL)
-    ffebld_init_list (&ffestc_local_.data.objlist,
-		      &ffestc_local_.data.list_bottom);
-
-  ffebld_append_item (&ffestc_local_.data.list_bottom, expr);
-#else
-  ffestd_R528_item_object_ (expr, expr_token);
-#endif
-}
-
-/* ffestc_R528_item_startvals -- DATA statement start list of values
-
-   ffestc_R528_item_startvals();
-
-   No more objects, gonna specify values for the list of objects now.  */
-
-void
-ffestc_R528_item_startvals (void)
-{
-  ffestc_check_item_startvals_ ();
-  if (!ffestc_ok_)
-    return;
-
-#if 1
-  assert (ffestc_local_.data.objlist != NULL);
-  ffebld_end_list (&ffestc_local_.data.list_bottom);
-  ffedata_begin (ffestc_local_.data.objlist);
-#else
-  ffestd_R528_item_startvals_ ();
-#endif
-}
-
-/* ffestc_R528_item_value -- DATA statement source value
-
-   ffestc_R528_item_value(repeat,repeat_token,value,value_token);
-
-   Make sure repeat and value are valid for the objects being initialized.  */
-
-void
-ffestc_R528_item_value (ffebld repeat, ffelexToken repeat_token,
-			ffebld value, ffelexToken value_token)
-{
-  ffetargetIntegerDefault rpt;
-
-  ffestc_check_item_value_ ();
-  if (!ffestc_ok_)
-    return;
-
-#if 1
-  if (repeat == NULL)
-    rpt = 1;
-  else if (ffebld_op (repeat) == FFEBLD_opCONTER)
-    rpt = ffebld_constant_integerdefault (ffebld_conter (repeat));
-  else
-    {
-      ffestc_ok_ = FALSE;
-      ffedata_end (TRUE, NULL);
-      return;
-    }
-
-  if (!(ffestc_ok_ = ffedata_value (rpt, value,
-				    (repeat_token == NULL)
-				    ? value_token
-				    : repeat_token)))
-    ffedata_end (TRUE, NULL);
-
-#else
-  ffestd_R528_item_value_ (repeat, value);
-#endif
-}
-
-/* ffestc_R528_item_endvals -- DATA statement start list of values
-
-   ffelexToken t;  // the SLASH token that ends the list.
-   ffestc_R528_item_endvals(t);
-
-   No more values, might specify more objects now.  */
-
-void
-ffestc_R528_item_endvals (ffelexToken t)
-{
-  ffestc_check_item_endvals_ ();
-  if (!ffestc_ok_)
-    return;
-
-#if 1
-  ffedata_end (!ffestc_ok_, t);
-  ffestc_local_.data.objlist = NULL;
-#else
-  ffestd_R528_item_endvals_ (t);
-#endif
-}
-
-/* ffestc_R528_finish -- DATA statement list complete
-
-   ffestc_R528_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R528_finish (void)
-{
-  ffestc_check_finish_ ();
-
-#if 1
-#else
-  ffestd_R528_finish_ ();
-#endif
-}
-
-/* ffestc_R537_start -- PARAMETER statement list begin
-
-   ffestc_R537_start();
-
-   Verify that PARAMETER is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R537_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_parameter_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  ffestd_R537_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R537_item -- PARAMETER statement assignment
-
-   ffestc_R537_item(dest,dest_token,source,source_token);
-
-   Make sure the source is a valid source for the destination; make the
-   assignment.	*/
-
-void
-ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source,
-		  ffelexToken source_token)
-{
-  ffesymbol s;
-
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-  if ((ffebld_op (dest) == FFEBLD_opANY)
-      || (ffebld_op (source) == FFEBLD_opANY))
-    {
-      if (ffebld_op (dest) == FFEBLD_opSYMTER)
-	{
-	  s = ffebld_symter (dest);
-	  ffesymbol_set_init (s, ffebld_new_any ());
-	  ffebld_set_info (ffesymbol_init (s), ffeinfo_new_any ());
-	  ffesymbol_signal_unreported (s);
-	}
-      ffestd_R537_item (dest, source);
-      return;
-    }
-
-  assert (ffebld_op (dest) == FFEBLD_opSYMTER);
-  assert (ffebld_op (source) == FFEBLD_opCONTER);
-
-  s = ffebld_symter (dest);
-  if ((ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
-      && (ffesymbol_size (s) == FFETARGET_charactersizeNONE))
-    {				/* Destination has explicit/implicit
-				   CHARACTER*(*) type; set length. */
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       0,
-				       ffesymbol_kind (s),
-				       ffesymbol_where (s),
-				       ffebld_size (source)));
-      ffebld_set_info (dest, ffeinfo_use (ffesymbol_info (s)));
-    }
-
-  source = ffeexpr_convert_expr (source, source_token, dest, dest_token,
-				 FFEEXPR_contextDATA);
-
-  ffesymbol_set_init (s, source);
-
-  ffesymbol_signal_unreported (s);
-
-  ffestd_R537_item (dest, source);
-}
-
-/* ffestc_R537_finish -- PARAMETER statement list complete
-
-   ffestc_R537_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R537_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R537_finish ();
-}
-
-/* ffestc_R539 -- IMPLICIT NONE statement
-
-   ffestc_R539();
-
-   Verify that the IMPLICIT NONE statement is ok here and implement.  */
-
-void
-ffestc_R539 (void)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_implicitnone_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  ffeimplic_none ();
-
-  ffestd_R539 ();
-}
-
-/* ffestc_R539start -- IMPLICIT statement
-
-   ffestc_R539start();
-
-   Verify that the IMPLICIT statement is ok here and implement.	 */
-
-void
-ffestc_R539start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_implicit_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestd_R539start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R539item -- IMPLICIT statement specification (R540)
-
-   ffestc_R539item(...);
-
-   Verify that the type and letter list are all ok and implement.  */
-
-void
-ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
-		 ffebld len, ffelexToken lent, ffesttImpList letters)
-{
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-  if ((type == FFESTP_typeCHARACTER) && (len != NULL)
-      && (ffebld_op (len) == FFEBLD_opSTAR))
-    {				/* Complain and pretend they're CHARACTER
-				   [*1]. */
-      ffebad_start (FFEBAD_IMPLICIT_ADJLEN);
-      ffebad_here (0, ffelex_token_where_line (lent),
-		   ffelex_token_where_column (lent));
-      ffebad_finish ();
-      len = NULL;
-      lent = NULL;
-    }
-  ffestc_establish_declstmt_ (type, ffesta_tokens[0], kind, kindt, len, lent);
-  ffestc_establish_declinfo_ (NULL, NULL, NULL, NULL);
-
-  ffestt_implist_drive (letters, ffestc_establish_impletter_);
-
-  ffestd_R539item (type, kind, kindt, len, lent, letters);
-}
-
-/* ffestc_R539finish -- IMPLICIT statement
-
-   ffestc_R539finish();
-
-   Finish up any local activities.  */
-
-void
-ffestc_R539finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R539finish ();
-}
-
-/* ffestc_R542_start -- NAMELIST statement list begin
-
-   ffestc_R542_start();
-
-   Verify that NAMELIST is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R542_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  if (ffe_is_f2c_library ()
-      && (ffe_case_source () == FFE_caseNONE))
-    {
-      ffebad_start (FFEBAD_NAMELIST_CASE);
-      ffesta_ffebad_here_current_stmt (0);
-      ffebad_finish ();
-    }
-
-  ffestd_R542_start ();
-
-  ffestc_local_.namelist.symbol = NULL;
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R542_item_nlist -- NAMELIST statement for group-name
-
-   ffestc_R542_item_nlist(groupname_token);
-
-   Make sure name_token identifies a valid object to be NAMELISTd.  */
-
-void
-ffestc_R542_item_nlist (ffelexToken name)
-{
-  ffesymbol s;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  if (ffestc_local_.namelist.symbol != NULL)
-    ffesymbol_signal_unreported (ffestc_local_.namelist.symbol);
-
-  s = ffesymbol_declare_local (name, FALSE);
-
-  if ((ffesymbol_state (s) == FFESYMBOL_stateNONE)
-      || ((ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	  && (ffesymbol_kind (s) == FFEINFO_kindNAMELIST)))
-    {
-      ffestc_parent_ok_ = TRUE;
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	{
-	  ffebld_init_list (ffesymbol_ptr_to_namelist (s),
-			    ffesymbol_ptr_to_listbottom (s));
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindNAMELIST,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	}
-    }
-  else
-    {
-      if (ffesymbol_kind (s) != FFEINFO_kindANY)
-	ffesymbol_error (s, name);
-      ffestc_parent_ok_ = FALSE;
-    }
-
-  ffestc_local_.namelist.symbol = s;
-
-  ffestd_R542_item_nlist (name);
-}
-
-/* ffestc_R542_item_nitem -- NAMELIST statement for variable-name
-
-   ffestc_R542_item_nitem(name_token);
-
-   Make sure name_token identifies a valid object to be NAMELISTd.  */
-
-void
-ffestc_R542_item_nitem (ffelexToken name)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffebld e;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  s = ffesymbol_declare_local (name, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s)
-      && ((ffesymbol_kind (s) != FFEINFO_kindENTITY)
-	  || ((ffesymbol_where (s) != FFEINFO_whereLOCAL)
-	      && (ffesymbol_where (s) != FFEINFO_whereCOMMON))))
-    na = FFESYMBOL_attrsetNONE;
-  else if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;
-  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		    | FFESYMBOL_attrsARRAY
-		    | FFESYMBOL_attrsCOMMON
-		    | FFESYMBOL_attrsEQUIV
-		    | FFESYMBOL_attrsINIT
-		    | FFESYMBOL_attrsNAMELIST
-		    | FFESYMBOL_attrsSAVE
-		    | FFESYMBOL_attrsSFARG
-		    | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsNAMELIST;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, name);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_set_namelisted (s, TRUE);
-      ffesymbol_signal_unreported (s);
-#if 0				/* No need to establish type yet! */
-      if (!ffeimplic_establish_symbol (s))
-	ffesymbol_error (s, name);
-#endif
-    }
-
-  if (ffestc_parent_ok_)
-    {
-      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-			     FFEINTRIN_impNONE);
-      ffebld_set_info (e,
-		       ffeinfo_new (FFEINFO_basictypeNONE,
-				    FFEINFO_kindtypeNONE, 0,
-				    FFEINFO_kindNONE,
-				    FFEINFO_whereNONE,
-				    FFETARGET_charactersizeNONE));
-      ffebld_append_item
-	(ffesymbol_ptr_to_listbottom (ffestc_local_.namelist.symbol), e);
-    }
-
-  ffestd_R542_item_nitem (name);
-}
-
-/* ffestc_R542_finish -- NAMELIST statement list complete
-
-   ffestc_R542_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R542_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffesymbol_signal_unreported (ffestc_local_.namelist.symbol);
-
-  ffestd_R542_finish ();
-}
-
-/* ffestc_R544_start -- EQUIVALENCE statement list begin
-
-   ffestc_R544_start();
-
-   Verify that EQUIVALENCE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R544_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R544_item -- EQUIVALENCE statement assignment
-
-   ffestc_R544_item(exprlist);
-
-   Make sure the equivalence is valid, then implement it.  */
-
-void
-ffestc_R544_item (ffesttExprList exprlist)
-{
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-  /* First we go through the list and come up with one ffeequiv object that
-     will describe all items in the list.  When an ffeequiv object is first
-     found, it is used (else we create one as a "local equiv" for the time
-     being).  If subsequent ffeequiv objects are found, they are merged with
-     the first so we end up with one.  However, if more than one COMMON
-     variable is involved, then an error condition occurs. */
-
-  ffestc_local_.equiv.ok = TRUE;
-  ffestc_local_.equiv.t = NULL;	/* No token yet. */
-  ffestc_local_.equiv.eq = NULL;/* No equiv yet. */
-  ffestc_local_.equiv.save = FALSE;	/* No SAVEd variables yet. */
-
-  ffebld_init_list (&ffestc_local_.equiv.list, &ffestc_local_.equiv.bottom);
-  ffestt_exprlist_drive (exprlist, ffestc_R544_equiv_);	/* Get one equiv. */
-  ffebld_end_list (&ffestc_local_.equiv.bottom);
-
-  if (!ffestc_local_.equiv.ok)
-    return;			/* Something went wrong, stop bothering with
-				   this stuff. */
-
-  if (ffestc_local_.equiv.eq == NULL)
-    ffestc_local_.equiv.eq = ffeequiv_new ();	/* Make local equivalence. */
-
-  /* Append this list of equivalences to list of such lists for this
-     equivalence. */
-
-  ffeequiv_add (ffestc_local_.equiv.eq, ffestc_local_.equiv.list,
-		ffestc_local_.equiv.t);
-  if (ffestc_local_.equiv.save)
-    ffeequiv_update_save (ffestc_local_.equiv.eq);
-}
-
-/* ffestc_R544_equiv_ -- EQUIVALENCE statement handler for item in list
-
-   ffebld expr;
-   ffelexToken t;
-   ffestc_R544_equiv_(expr,t);
-
-   Record information, if any, on symbol in expr; if symbol has equivalence
-   object already, merge with outstanding object if present or make it
-   the outstanding object.  */
-
-static void
-ffestc_R544_equiv_ (ffebld expr, ffelexToken t)
-{
-  ffesymbol s;
-
-  if (!ffestc_local_.equiv.ok)
-    return;
-
-  if (ffestc_local_.equiv.t == NULL)
-    ffestc_local_.equiv.t = t;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opANY:
-      return;			/* Don't put this on the list. */
-
-    case FFEBLD_opSYMTER:
-    case FFEBLD_opARRAYREF:
-    case FFEBLD_opSUBSTR:
-      break;			/* All of these are ok. */
-
-    default:
-      assert ("ffestc_R544_equiv_ bad op" == NULL);
-      return;
-    }
-
-  ffebld_append_item (&ffestc_local_.equiv.bottom, expr);
-
-  s = ffeequiv_symbol (expr);
-
-  /* See if symbol has an equivalence object already. */
-
-  if (ffesymbol_equiv (s) != NULL)
-    {
-      if (ffestc_local_.equiv.eq == NULL)
-	ffestc_local_.equiv.eq = ffesymbol_equiv (s);	/* New equiv obj. */
-      else if (ffestc_local_.equiv.eq != ffesymbol_equiv (s))
-	{
-	  ffestc_local_.equiv.eq = ffeequiv_merge (ffesymbol_equiv (s),
-						   ffestc_local_.equiv.eq,
-						   t);
-	  if (ffestc_local_.equiv.eq == NULL)
-	    ffestc_local_.equiv.ok = FALSE;	/* Couldn't merge. */
-	}
-    }
-
-  if (ffesymbol_is_save (s))
-    ffestc_local_.equiv.save = TRUE;
-}
-
-/* ffestc_R544_finish -- EQUIVALENCE statement list complete
-
-   ffestc_R544_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R544_finish (void)
-{
-  ffestc_check_finish_ ();
-}
-
-/* ffestc_R547_start -- COMMON statement list begin
-
-   ffestc_R547_start();
-
-   Verify that COMMON is valid here, and begin accepting items in the list.  */
-
-void
-ffestc_R547_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_blockspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestc_local_.common.symbol = NULL;	/* Blank common is the default. */
-  ffestc_parent_ok_ = TRUE;
-
-  ffestd_R547_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R547_item_object -- COMMON statement for object-name
-
-   ffestc_R547_item_object(name_token,dim_list);
-
-   Make sure name_token identifies a valid object to be COMMONd.  */
-
-void
-ffestc_R547_item_object (ffelexToken name, ffesttDimList dims)
-{
-  ffesymbol s;
-  ffebld array_size;
-  ffebld extents;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffestpDimtype nd;
-  ffebld e;
-  ffeinfoRank rank;
-  bool is_ugly_assumed;
-
-  if (ffestc_parent_ok_ && (ffestc_local_.common.symbol == NULL))
-    ffestc_R547_item_cblock (NULL);	/* As if "COMMON [//] ...". */
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  if (dims != NULL)
-    ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  s = ffesymbol_declare_local (name, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* First figure out what kind of object this is based solely on the current
-     object situation (dimension list). */
-
-  is_ugly_assumed = (ffe_is_ugly_assumed ()
-		     && ((sa & FFESYMBOL_attrsDUMMY)
-			 || (ffesymbol_where (s) == FFEINFO_whereDUMMY)));
-
-  nd = ffestt_dimlist_type (dims, is_ugly_assumed);
-  switch (nd)
-    {
-    case FFESTP_dimtypeNONE:
-      na = FFESYMBOL_attrsCOMMON;
-      break;
-
-    case FFESTP_dimtypeKNOWN:
-      na = FFESYMBOL_attrsCOMMON | FFESYMBOL_attrsARRAY;
-      break;
-
-    default:
-      na = FFESYMBOL_attrsetNONE;
-      break;
-    }
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ;
-  else if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;
-  else if ((sa & (FFESYMBOL_attrsADJUSTS
-		  | FFESYMBOL_attrsARRAY
-		  | FFESYMBOL_attrsINIT
-		  | FFESYMBOL_attrsSFARG))
-	   && (na & FFESYMBOL_attrsARRAY))
-    na = FFESYMBOL_attrsetNONE;
-  else if (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		    | FFESYMBOL_attrsARRAY
-		    | FFESYMBOL_attrsEQUIV
-		    | FFESYMBOL_attrsINIT
-		    | FFESYMBOL_attrsNAMELIST
-		    | FFESYMBOL_attrsSFARG
-		    | FFESYMBOL_attrsTYPE)))
-    na |= sa;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, name);
-  else if ((ffesymbol_equiv (s) != NULL)
-	   && (ffeequiv_common (ffesymbol_equiv (s)) != NULL)
-	   && (ffeequiv_common (ffesymbol_equiv (s))
-	       != ffestc_local_.common.symbol))
-    {
-      /* Oops, just COMMONed a symbol to a different area (via equiv).  */
-      ffebad_start (FFEBAD_EQUIV_COMMON);
-      ffebad_here (0, ffelex_token_where_line (name),
-		   ffelex_token_where_column (name));
-      ffebad_string (ffesymbol_text (ffestc_local_.common.symbol));
-      ffebad_string (ffesymbol_text (ffeequiv_common (ffesymbol_equiv (s))));
-      ffebad_finish ();
-      ffesymbol_set_attr (s, na | FFESYMBOL_attrANY);
-      ffesymbol_set_info (s, ffeinfo_new_any ());
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_signal_unreported (s);
-    }
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_set_common (s, ffestc_local_.common.symbol);
-#if FFEGLOBAL_ENABLED
-      if (ffesymbol_is_init (s))
-	ffeglobal_init_common (ffestc_local_.common.symbol, name);
-#endif
-      if (ffesymbol_is_save (ffestc_local_.common.symbol))
-	ffesymbol_update_save (s);
-      if (ffesymbol_equiv (s) != NULL)
-	{			/* Is this newly COMMONed symbol involved in
-				   an equivalence? */
-	  if (ffeequiv_common (ffesymbol_equiv (s)) == NULL)
-	    ffeequiv_set_common (ffesymbol_equiv (s),	/* Yes, tell equiv obj. */
-				 ffestc_local_.common.symbol);
-#if FFEGLOBAL_ENABLED
-	  if (ffeequiv_is_init (ffesymbol_equiv (s)))
-	    ffeglobal_init_common (ffestc_local_.common.symbol, name);
-#endif
-	  if (ffesymbol_is_save (ffestc_local_.common.symbol))
-	    ffeequiv_update_save (ffesymbol_equiv (s));
-	}
-      if (dims != NULL)
-	{
-	  ffesymbol_set_dims (s, ffestt_dimlist_as_expr (dims, &rank,
-							 &array_size,
-							 &extents,
-							 is_ugly_assumed));
-	  ffesymbol_set_arraysize (s, array_size);
-	  ffesymbol_set_extents (s, extents);
-	  if (!(0 && ffe_is_90 ())
-	      && (ffebld_op (array_size) == FFEBLD_opCONTER)
-	      && (ffebld_constant_integerdefault (ffebld_conter (array_size))
-		  == 0))
-	    {
-	      ffebad_start (FFEBAD_ZERO_ARRAY);
-	      ffebad_here (0, ffelex_token_where_line (name),
-			   ffelex_token_where_column (name));
-	      ffebad_finish ();
-	    }
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (ffesymbol_basictype (s),
-					   ffesymbol_kindtype (s),
-					   rank,
-					   ffesymbol_kind (s),
-					   ffesymbol_where (s),
-					   ffesymbol_size (s)));
-	}
-      ffesymbol_signal_unreported (s);
-    }
-
-  if (ffestc_parent_ok_)
-    {
-      e = ffebld_new_symter (s, FFEINTRIN_genNONE, FFEINTRIN_specNONE,
-			     FFEINTRIN_impNONE);
-      ffebld_set_info (e,
-		       ffeinfo_new (FFEINFO_basictypeNONE,
-				    FFEINFO_kindtypeNONE,
-				    0,
-				    FFEINFO_kindNONE,
-				    FFEINFO_whereNONE,
-				    FFETARGET_charactersizeNONE));
-      ffebld_append_item
-	(ffesymbol_ptr_to_listbottom (ffestc_local_.common.symbol), e);
-    }
-
-  ffestd_R547_item_object (name, dims);
-}
-
-/* ffestc_R547_item_cblock -- COMMON statement for common-block-name
-
-   ffestc_R547_item_cblock(name_token);
-
-   Make sure name_token identifies a valid common block to be COMMONd.	*/
-
-void
-ffestc_R547_item_cblock (ffelexToken name)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-  if (ffestc_local_.common.symbol != NULL)
-    ffesymbol_signal_unreported (ffestc_local_.common.symbol);
-
-  s = ffesymbol_declare_cblock (name,
-				ffelex_token_where_line (ffesta_tokens[0]),
-			      ffelex_token_where_column (ffesta_tokens[0]));
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;
-  else if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;	/* Already have an error here, say nothing. */
-  else if (!(sa & ~(FFESYMBOL_attrsCBLOCK
-		    | FFESYMBOL_attrsSAVECBLOCK)))
-    {
-      if (!(sa & FFESYMBOL_attrsCBLOCK))
-	ffebld_init_list (ffesymbol_ptr_to_commonlist (s),
-			  ffesymbol_ptr_to_listbottom (s));
-      na = sa | FFESYMBOL_attrsCBLOCK;
-    }
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    {
-      ffesymbol_error (s, name == NULL ? ffesta_tokens[0] : name);
-      ffestc_parent_ok_ = FALSE;
-    }
-  else if (na & FFESYMBOL_attrsANY)
-    ffestc_parent_ok_ = FALSE;
-  else
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      if (name == NULL)
-	ffesymbol_update_save (s);
-      ffestc_parent_ok_ = TRUE;
-    }
-
-  ffestc_local_.common.symbol = s;
-
-  ffestd_R547_item_cblock (name);
-}
-
-/* ffestc_R547_finish -- COMMON statement list complete
-
-   ffestc_R547_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R547_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  if (ffestc_local_.common.symbol != NULL)
-    ffesymbol_signal_unreported (ffestc_local_.common.symbol);
-
-  ffestd_R547_finish ();
-}
-
-/* ffestc_R737 -- Assignment statement
-
-   ffestc_R737(dest_expr,source_expr,source_token);
-
-   Make sure the assignment is valid.  */
-
-void
-ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token)
-{
-  ffestc_check_simple_ ();
-
-  if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  source = ffeexpr_convert_expr (source, source_token, dest, ffesta_tokens[0],
-				 FFEEXPR_contextLET);
-
-  ffestd_R737A (dest, source);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R803 -- Block IF (IF-THEN) statement
-
-   ffestc_R803(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R803 (ffelexToken construct_name, ffebld expr,
-	     ffelexToken expr_token UNUSED)
-{
-  ffestw b;
-  ffesymbol s;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_exec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
-  ffestw_set_state (b, FFESTV_stateIFTHEN);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_ifthen_);
-  ffestw_set_substate (b, 0);	/* Haven't seen ELSE yet. */
-
-  if (construct_name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    {
-      ffestw_set_name (b, ffelex_token_use (construct_name));
-
-      s = ffesymbol_declare_local (construct_name, FALSE);
-
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	{
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindCONSTRUCT,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);
-	}
-      else
-	ffesymbol_error (s, construct_name);
-    }
-
-  ffestd_R803 (construct_name, expr);
-}
-
-/* ffestc_R804 -- ELSE IF statement
-
-   ffestc_R804(expr,expr_token,name_token);
-
-   Make sure ffestc_kind_ identifies an IF block.  If not
-   NULL, make sure name_token gives the correct name.  Implement the else
-   of the IF block.  */
-
-void
-ffestc_R804 (ffebld expr, ffelexToken expr_token UNUSED,
-	     ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  if (name != NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (ffelex_token_strcmp (name,
-				    ffestw_name (ffestw_stack_top ()))
-	       != 0)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_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 ();
-	}
-    }
-
-  if (ffestw_substate (ffestw_stack_top ()) != 0)
-    {
-      ffebad_start (FFEBAD_AFTER_ELSE);
-      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;			/* Don't upset back end with ELSEIF
-				   after ELSE. */
-    }
-
-  ffestd_R804 (expr, name);
-}
-
-/* ffestc_R805 -- ELSE statement
-
-   ffestc_R805(name_token);
-
-   Make sure ffestc_kind_ identifies an IF block.  If not
-   NULL, make sure name_token gives the correct name.  Implement the ELSE
-   of the IF block.  */
-
-void
-ffestc_R805 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  if (name != NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_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 ();
-	}
-    }
-
-  if (ffestw_substate (ffestw_stack_top ()) != 0)
-    {
-      ffebad_start (FFEBAD_AFTER_ELSE);
-      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;			/* Tell back end about only one ELSE. */
-    }
-
-  ffestw_set_substate (ffestw_stack_top (), 1);	/* Saw ELSE. */
-
-  ffestd_R805 (name);
-}
-
-/* ffestc_R806 -- END IF statement
-
-   ffestc_R806(name_token);
-
-   Make sure ffestc_kind_ identifies an IF block.  If not
-   NULL, make sure name_token gives the correct name.  Implement the end
-   of the IF block.  */
-
-void
-ffestc_R806 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_ifthen_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_endif_ ();
-
-  if (name == NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) != NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NAMED);
-	  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 ();
-	}
-    }
-  else
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (ffelex_token_strcmp (name, ffestw_name (ffestw_stack_top ())) != 0)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_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_ifthen_ (TRUE);
-}
-
-/* ffestc_R807 -- Logical IF statement
-
-   ffestc_R807(expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R807 (ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffestw b;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_action_ () != 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_stateIF);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_if_lost_);
-
-  ffestd_R807 (expr);
-
-  /* Do the label finishing in the next statement. */
-
-}
-
-/* ffestc_R809 -- SELECT CASE statement
-
-   ffestc_R809(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R809 (ffelexToken construct_name, ffebld expr, ffelexToken expr_token)
-{
-  ffestw b;
-  mallocPool pool;
-  ffestwSelect s;
-  ffesymbol sym;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_exec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, ffestw_top_do (ffestw_previous (b)));
-  ffestw_set_state (b, FFESTV_stateSELECT0);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_select_);
-  ffestw_set_substate (b, 0);	/* Haven't seen CASE DEFAULT yet. */
-
-  /* Init block to manage CASE list. */
-
-  pool = malloc_pool_new ("Select", ffe_pool_any_unit (), 1024);
-  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;
-  s->last_stmt = (ffestwCase) &s->first_rel;
-  s->pool = pool;
-  s->cases = 1;
-  s->t = ffelex_token_use (expr_token);
-  s->type = ffeinfo_basictype (ffebld_info (expr));
-  s->kindtype = ffeinfo_kindtype (ffebld_info (expr));
-  ffestw_set_select (b, s);
-
-  if (construct_name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    {
-      ffestw_set_name (b, ffelex_token_use (construct_name));
-
-      sym = ffesymbol_declare_local (construct_name, FALSE);
-
-      if (ffesymbol_state (sym) == FFESYMBOL_stateNONE)
-	{
-	  ffesymbol_set_state (sym, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (sym,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE, 0,
-					   FFEINFO_kindCONSTRUCT,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	  sym = ffecom_sym_learned (sym);
-	  ffesymbol_signal_unreported (sym);
-	}
-      else
-	ffesymbol_error (sym, construct_name);
-    }
-
-  ffestd_R809 (construct_name, expr);
-}
-
-/* ffestc_R810 -- CASE statement
-
-   ffestc_R810(case_value_range_list,name);
-
-   If case_value_range_list is NULL, it's CASE DEFAULT.	 name is the case-
-   construct-name.  Make sure no more than one CASE DEFAULT is present for
-   a given case-construct and that there aren't any overlapping ranges or
-   duplicate case values.  */
-
-void
-ffestc_R810 (ffesttCaseList cases, ffelexToken name)
-{
-  ffesttCaseList caseobj;
-  ffestwSelect s;
-  ffestwCase c, nc;
-  ffebldConstant expr1c, expr2c;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_selectcase_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  s = ffestw_select (ffestw_stack_top ());
-
-  if (ffestw_state (ffestw_stack_top ()) == FFESTV_stateSELECT0)
-    {
-#if 0				/* Not sure we want to have msgs point here
-				   instead of SELECT CASE. */
-      ffestw_update (NULL);	/* Update state line/col info. */
-#endif
-      ffestw_set_state (ffestw_stack_top (), FFESTV_stateSELECT1);
-    }
-
-  if (name != NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (ffelex_token_strcmp (name,
-				    ffestw_name (ffestw_stack_top ()))
-	       != 0)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_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 ();
-	}
-    }
-
-  if (cases == NULL)
-    {
-      if (ffestw_substate (ffestw_stack_top ()) != 0)
-	{
-	  ffebad_start (FFEBAD_CASE_SECOND_DEFAULT);
-	  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 ELSE. */
-    }
-  else
-    {				/* For each case, try to fit into sorted list
-				   of ranges. */
-      for (caseobj = cases->next; caseobj != cases; caseobj = caseobj->next)
-	{
-	  if ((caseobj->expr1 == NULL)
-	      && (!caseobj->range
-		  || (caseobj->expr2 == NULL)))
-	    {			/* "CASE (:)". */
-	      ffebad_start (FFEBAD_CASE_BAD_RANGE);
-	      ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			   ffelex_token_where_column (caseobj->t));
-	      ffebad_finish ();
-	      continue;
-	    }
-	  if (((caseobj->expr1 != NULL)
-	       && ((ffeinfo_basictype (ffebld_info (caseobj->expr1))
-		    != s->type)
-		   || ((ffeinfo_kindtype (ffebld_info (caseobj->expr1))
-		       != s->kindtype)
-		       && (ffeinfo_kindtype (ffebld_info (caseobj->expr1)) != FFEINFO_kindtypeINTEGER1 ))
-	      || ((caseobj->range)
-		  && (caseobj->expr2 != NULL)
-		  && ((ffeinfo_basictype (ffebld_info (caseobj->expr2))
-		       != s->type)
-		      || ((ffeinfo_kindtype (ffebld_info (caseobj->expr2))
-			  != s->kindtype)
-		      && (ffeinfo_kindtype (ffebld_info (caseobj->expr2)) != FFEINFO_kindtypeINTEGER1)))))))
-	    {
-	      ffebad_start (FFEBAD_CASE_TYPE_DISAGREE);
-	      ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			   ffelex_token_where_column (caseobj->t));
-	      ffebad_here (1, ffelex_token_where_line (s->t),
-			   ffelex_token_where_column (s->t));
-	      ffebad_finish ();
-	      continue;
-	    }
-
-
-
-	  if ((s->type == FFEINFO_basictypeLOGICAL) && (caseobj->range))
-	    {
-	      ffebad_start (FFEBAD_CASE_LOGICAL_RANGE);
-	      ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			   ffelex_token_where_column (caseobj->t));
-	      ffebad_finish ();
-	      continue;
-	    }
-
-	  if (caseobj->expr1 == NULL)
-	    expr1c = NULL;
-	  else if (ffebld_op (caseobj->expr1) != FFEBLD_opCONTER)
-	    continue;		/* opANY. */
-	  else
-	    expr1c = ffebld_conter (caseobj->expr1);
-
-	  if (!caseobj->range)
-	    expr2c = expr1c;	/* expr1c and expr2c are NOT NULL in this
-				   case. */
-	  else if (caseobj->expr2 == NULL)
-	    expr2c = NULL;
-	  else if (ffebld_op (caseobj->expr2) != FFEBLD_opCONTER)
-	    continue;		/* opANY. */
-	  else
-	    expr2c = ffebld_conter (caseobj->expr2);
-
-	  if (expr1c == NULL)
-	    {			/* "CASE (:high)", must be first in list. */
-	      c = s->first_rel;
-	      if ((c != (ffestwCase) &s->first_rel)
-		  && ((c->low == NULL)
-		      || (ffebld_constant_cmp (expr2c, c->low) >= 0)))
-		{		/* Other "CASE (:high)" or lowest "CASE
-				   (low[:high])" low. */
-		  ffebad_start (FFEBAD_CASE_DUPLICATE);
-		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			       ffelex_token_where_column (caseobj->t));
-		  ffebad_here (1, ffelex_token_where_line (c->t),
-			       ffelex_token_where_column (c->t));
-		  ffebad_finish ();
-		  continue;
-		}
-	    }
-	  else if (expr2c == NULL)
-	    {			/* "CASE (low:)", must be last in list. */
-	      c = s->last_rel;
-	      if ((c != (ffestwCase) &s->first_rel)
-		  && ((c->high == NULL)
-		      || (ffebld_constant_cmp (expr1c, c->high) <= 0)))
-		{		/* Other "CASE (low:)" or lowest "CASE
-				   ([low:]high)" high. */
-		  ffebad_start (FFEBAD_CASE_DUPLICATE);
-		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			       ffelex_token_where_column (caseobj->t));
-		  ffebad_here (1, ffelex_token_where_line (c->t),
-			       ffelex_token_where_column (c->t));
-		  ffebad_finish ();
-		  continue;
-		}
-	      c = c->next_rel;	/* Same as c = (ffestwCase) &s->first;. */
-	    }
-	  else
-	    {			/* (expr1c != NULL) && (expr2c != NULL). */
-	      if (ffebld_constant_cmp (expr1c, expr2c) > 0)
-		{		/* Such as "CASE (3:1)" or "CASE ('B':'A')". */
-		  ffebad_start (FFEBAD_CASE_RANGE_USELESS);	/* Warn/inform only. */
-		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			       ffelex_token_where_column (caseobj->t));
-		  ffebad_finish ();
-		  continue;
-		}
-	      for (c = s->first_rel;
-		   (c != (ffestwCase) &s->first_rel)
-		   && ((c->low == NULL)
-		       || (ffebld_constant_cmp (expr1c, c->low) > 0));
-		   c = c->next_rel)
-		;
-	      nc = c;		/* Which one to report? */
-	      if (((c != (ffestwCase) &s->first_rel)
-		   && (ffebld_constant_cmp (expr2c, c->low) >= 0))
-		  || (((nc = c->previous_rel) != (ffestwCase) &s->first_rel)
-		      && (ffebld_constant_cmp (expr1c, nc->high) <= 0)))
-		{		/* Interference with range in case nc. */
-		  ffebad_start (FFEBAD_CASE_DUPLICATE);
-		  ffebad_here (0, ffelex_token_where_line (caseobj->t),
-			       ffelex_token_where_column (caseobj->t));
-		  ffebad_here (1, ffelex_token_where_line (nc->t),
-			       ffelex_token_where_column (nc->t));
-		  ffebad_finish ();
-		  continue;
-		}
-	    }
-
-	  /* If we reach here for this case range/value, it's ok (sorts into
-	     the list of ranges/values) so we give it its own case object
-	     sorted into the list of case statements. */
-
-	  nc = malloc_new_kp (s->pool, "Case range", sizeof (*nc));
-	  nc->next_rel = c;
-	  nc->previous_rel = c->previous_rel;
-	  nc->next_stmt = (ffestwCase) &s->first_rel;
-	  nc->previous_stmt = s->last_stmt;
-	  nc->low = expr1c;
-	  nc->high = expr2c;
-	  nc->casenum = s->cases;
-	  nc->t = ffelex_token_use (caseobj->t);
-	  nc->next_rel->previous_rel = nc;
-	  nc->previous_rel->next_rel = nc;
-	  nc->next_stmt->previous_stmt = nc;
-	  nc->previous_stmt->next_stmt = nc;
-	}
-    }
-
-  ffestd_R810 ((cases == NULL) ? 0 : s->cases);
-
-  s->cases++;			/* Increment # of cases. */
-}
-
-/* ffestc_R811 -- END SELECT statement
-
-   ffestc_R811(name_token);
-
-   Make sure ffestc_kind_ identifies a SELECT block.  If not
-   NULL, make sure name_token gives the correct name.  Implement the end
-   of the SELECT block.	 */
-
-void
-ffestc_R811 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_selectcase_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  if (name == NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) != NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NAMED);
-	  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 ();
-	}
-    }
-  else
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (ffelex_token_strcmp (name,
-				    ffestw_name (ffestw_stack_top ()))
-	       != 0)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_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_select_ (TRUE);
-}
-
-/* ffestc_R819A -- Iterative labeled DO statement
-
-   ffestc_R819A(construct_name,label_token,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R819A (ffelexToken construct_name, ffelexToken label_token, ffebld var,
-   ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
-	      ffelexToken end_token, ffebld incr, ffelexToken incr_token)
-{
-  ffestw b;
-  ffelab label;
-  ffesymbol s;
-  ffesymbol varsym;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_exec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  if (!ffestc_labelref_is_loopend_ (label_token, &label))
-    return;
-
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, b);
-  ffestw_set_state (b, FFESTV_stateDO);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_do_);
-  ffestw_set_label (b, label);
-  switch (ffebld_op (var))
-    {
-    case FFEBLD_opSYMTER:
-      if ((ffeinfo_basictype (ffebld_info (var)) == FFEINFO_basictypeREAL)
-	  && ffe_is_warn_surprising ())
-	{
-	  ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
-	  ffebad_here (0, ffelex_token_where_line (var_token),
-		       ffelex_token_where_column (var_token));
-	  ffebad_string (ffesymbol_text (ffebld_symter (var)));
-	  ffebad_finish ();
-	}
-      if (!ffesymbol_is_doiter (varsym = ffebld_symter (var)))
-	{			/* Presumably already complained about by
-				   ffeexpr_lhs_. */
-	  ffesymbol_set_is_doiter (varsym, TRUE);
-	  ffestw_set_do_iter_var (b, varsym);
-	  ffestw_set_do_iter_var_t (b, ffelex_token_use (var_token));
-	  break;
-	}
-      /* Fall through. */
-    case FFEBLD_opANY:
-      ffestw_set_do_iter_var (b, NULL);
-      ffestw_set_do_iter_var_t (b, NULL);
-      break;
-
-    default:
-      assert ("bad iter var" == NULL);
-      break;
-    }
-
-  if (construct_name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    {
-      ffestw_set_name (b, ffelex_token_use (construct_name));
-
-      s = ffesymbol_declare_local (construct_name, FALSE);
-
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	{
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindCONSTRUCT,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);
-	}
-      else
-	ffesymbol_error (s, construct_name);
-    }
-
-  if (incr == NULL)
-    {
-      incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
-      ffebld_set_info (incr, ffeinfo_new
-		       (FFEINFO_basictypeINTEGER,
-			FFEINFO_kindtypeINTEGERDEFAULT,
-			0,
-			FFEINFO_kindENTITY,
-			FFEINFO_whereCONSTANT,
-			FFETARGET_charactersizeNONE));
-    }
-
-  start = ffeexpr_convert_expr (start, start_token, var, var_token,
-				FFEEXPR_contextLET);
-  end = ffeexpr_convert_expr (end, end_token, var, var_token,
-			      FFEEXPR_contextLET);
-  incr = ffeexpr_convert_expr (incr, incr_token, var, var_token,
-			       FFEEXPR_contextLET);
-
-  ffestd_R819A (construct_name, label, var,
-		start, start_token,
-		end, end_token,
-		incr, incr_token);
-}
-
-/* ffestc_R819B -- Labeled DO WHILE statement
-
-   ffestc_R819B(construct_name,label_token,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R819B (ffelexToken construct_name, ffelexToken label_token,
-	      ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffestw b;
-  ffelab label;
-  ffesymbol s;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_exec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  if (!ffestc_labelref_is_loopend_ (label_token, &label))
-    return;
-
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, b);
-  ffestw_set_state (b, FFESTV_stateDO);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_do_);
-  ffestw_set_label (b, label);
-  ffestw_set_do_iter_var (b, NULL);
-  ffestw_set_do_iter_var_t (b, NULL);
-
-  if (construct_name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    {
-      ffestw_set_name (b, ffelex_token_use (construct_name));
-
-      s = ffesymbol_declare_local (construct_name, FALSE);
-
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	{
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindCONSTRUCT,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);
-	}
-      else
-	ffesymbol_error (s, construct_name);
-    }
-
-  ffestd_R819B (construct_name, label, expr);
-}
-
-/* ffestc_R820A -- Iterative nonlabeled DO statement
-
-   ffestc_R820A(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R820A (ffelexToken construct_name, ffebld var, ffelexToken var_token,
-   ffebld start, ffelexToken start_token, ffebld end, ffelexToken end_token,
-	      ffebld incr, ffelexToken incr_token)
-{
-  ffestw b;
-  ffesymbol s;
-  ffesymbol varsym;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_exec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, b);
-  ffestw_set_state (b, FFESTV_stateDO);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_do_);
-  ffestw_set_label (b, NULL);
-  switch (ffebld_op (var))
-    {
-    case FFEBLD_opSYMTER:
-      if ((ffeinfo_basictype (ffebld_info (var)) == FFEINFO_basictypeREAL)
-	  && ffe_is_warn_surprising ())
-	{
-	  ffebad_start (FFEBAD_DO_REAL);	/* See error message!!! */
-	  ffebad_here (0, ffelex_token_where_line (var_token),
-		       ffelex_token_where_column (var_token));
-	  ffebad_string (ffesymbol_text (ffebld_symter (var)));
-	  ffebad_finish ();
-	}
-      if (!ffesymbol_is_doiter (varsym = ffebld_symter (var)))
-	{			/* Presumably already complained about by
-				   ffeexpr_lhs_. */
-	  ffesymbol_set_is_doiter (varsym, TRUE);
-	  ffestw_set_do_iter_var (b, varsym);
-	  ffestw_set_do_iter_var_t (b, ffelex_token_use (var_token));
-	  break;
-	}
-      /* Fall through. */
-    case FFEBLD_opANY:
-      ffestw_set_do_iter_var (b, NULL);
-      ffestw_set_do_iter_var_t (b, NULL);
-      break;
-
-    default:
-      assert ("bad iter var" == NULL);
-      break;
-    }
-
-  if (construct_name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    {
-      ffestw_set_name (b, ffelex_token_use (construct_name));
-
-      s = ffesymbol_declare_local (construct_name, FALSE);
-
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	{
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindCONSTRUCT,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);
-	}
-      else
-	ffesymbol_error (s, construct_name);
-    }
-
-  if (incr == NULL)
-    {
-      incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
-      ffebld_set_info (incr, ffeinfo_new
-		       (FFEINFO_basictypeINTEGER,
-			FFEINFO_kindtypeINTEGERDEFAULT,
-			0,
-			FFEINFO_kindENTITY,
-			FFEINFO_whereCONSTANT,
-			FFETARGET_charactersizeNONE));
-    }
-
-  start = ffeexpr_convert_expr (start, start_token, var, var_token,
-				FFEEXPR_contextLET);
-  end = ffeexpr_convert_expr (end, end_token, var, var_token,
-			      FFEEXPR_contextLET);
-  incr = ffeexpr_convert_expr (incr, incr_token, var, var_token,
-			       FFEEXPR_contextLET);
-
-#if 0
-  if ((ffebld_op (incr) == FFEBLD_opCONTER)
-      && (ffebld_constant_is_zero (ffebld_conter (incr))))
-    {
-      ffebad_start (FFEBAD_DO_STEP_ZERO);
-      ffebad_here (0, ffelex_token_where_line (incr_token),
-		   ffelex_token_where_column (incr_token));
-      ffebad_string ("Iterative DO loop");
-      ffebad_finish ();
-    }
-#endif
-
-  ffestd_R819A (construct_name, NULL, var,
-		start, start_token,
-		end, end_token,
-		incr, incr_token);
-}
-
-/* ffestc_R820B -- Nonlabeled DO WHILE statement
-
-   ffestc_R820B(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R820B (ffelexToken construct_name, ffebld expr,
-	      ffelexToken expr_token UNUSED)
-{
-  ffestw b;
-  ffesymbol s;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_exec_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, b);
-  ffestw_set_state (b, FFESTV_stateDO);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_do_);
-  ffestw_set_label (b, NULL);
-  ffestw_set_do_iter_var (b, NULL);
-  ffestw_set_do_iter_var_t (b, NULL);
-
-  if (construct_name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    {
-      ffestw_set_name (b, ffelex_token_use (construct_name));
-
-      s = ffesymbol_declare_local (construct_name, FALSE);
-
-      if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	{
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindCONSTRUCT,
-					   FFEINFO_whereLOCAL,
-					   FFETARGET_charactersizeNONE));
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_signal_unreported (s);
-	}
-      else
-	ffesymbol_error (s, construct_name);
-    }
-
-  ffestd_R819B (construct_name, NULL, expr);
-}
-
-/* ffestc_R825 -- END DO statement
-
-   ffestc_R825(name_token);
-
-   Make sure ffestc_kind_ identifies a DO block.  If not
-   NULL, make sure name_token gives the correct name.  Implement the end
-   of the DO block.  */
-
-void
-ffestc_R825 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_do_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  if (name == NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) != NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NAMED);
-	  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 ();
-	}
-    }
-  else
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (ffelex_token_strcmp (name,
-				    ffestw_name (ffestw_stack_top ()))
-	       != 0)
-	{
-	  ffebad_start (FFEBAD_CONSTRUCT_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 ();
-	}
-    }
-
-  if (ffesta_label_token == NULL)
-    {				/* If top of stack has label, its an error! */
-      if (ffestw_label (ffestw_stack_top ()) != NULL)
-	{
-	  ffebad_start (FFEBAD_DO_HAD_LABEL);
-	  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_do_ (TRUE);
-
-      ffestc_try_shriek_do_ ();
-
-      return;
-    }
-
-  ffestd_R825 (name);
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R834 -- CYCLE statement
-
-   ffestc_R834(name_token);
-
-   Handle a CYCLE within a loop.  */
-
-void
-ffestc_R834 (ffelexToken name)
-{
-  ffestw block;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actiondo_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  if (name == NULL)
-    block = ffestw_top_do (ffestw_stack_top ());
-  else
-    {				/* Search for name. */
-      for (block = ffestw_top_do (ffestw_stack_top ());
-	   (block != NULL) && (ffestw_blocknum (block) != 0);
-	   block = ffestw_top_do (ffestw_previous (block)))
-	{
-	  if ((ffestw_name (block) != NULL)
-	      && (ffelex_token_strcmp (name, ffestw_name (block)) == 0))
-	    break;
-	}
-      if ((block == NULL) || (ffestw_blocknum (block) == 0))
-	{
-	  block = ffestw_top_do (ffestw_stack_top ());
-	  ffebad_start (FFEBAD_CONSTRUCT_NO_DO_NAME);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_finish ();
-	}
-    }
-
-  ffestd_R834 (block);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) CYCLE".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R835 -- EXIT statement
-
-   ffestc_R835(name_token);
-
-   Handle a EXIT within a loop.	 */
-
-void
-ffestc_R835 (ffelexToken name)
-{
-  ffestw block;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actiondo_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  if (name == NULL)
-    block = ffestw_top_do (ffestw_stack_top ());
-  else
-    {				/* Search for name. */
-      for (block = ffestw_top_do (ffestw_stack_top ());
-	   (block != NULL) && (ffestw_blocknum (block) != 0);
-	   block = ffestw_top_do (ffestw_previous (block)))
-	{
-	  if ((ffestw_name (block) != NULL)
-	      && (ffelex_token_strcmp (name, ffestw_name (block)) == 0))
-	    break;
-	}
-      if ((block == NULL) || (ffestw_blocknum (block) == 0))
-	{
-	  block = ffestw_top_do (ffestw_stack_top ());
-	  ffebad_start (FFEBAD_CONSTRUCT_NO_DO_NAME);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_finish ();
-	}
-    }
-
-  ffestd_R835 (block);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) EXIT".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R836 -- GOTO statement
-
-   ffestc_R836(label_token);
-
-   Make sure label_token identifies a valid label for a GOTO.  Update
-   that label's info to indicate it is the target of a GOTO.  */
-
-void
-ffestc_R836 (ffelexToken label_token)
-{
-  ffelab label;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  if (ffestc_labelref_is_branch_ (label_token, &label))
-    ffestd_R836 (label);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) GOTO 100".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R837 -- Computed GOTO statement
-
-   ffestc_R837(label_list,expr,expr_token);
-
-   Make sure label_list identifies valid labels for a GOTO.  Update
-   each label's info to indicate it is the target of a GOTO.  */
-
-void
-ffestc_R837 (ffesttTokenList label_toks, ffebld expr,
-	     ffelexToken expr_token UNUSED)
-{
-  ffesttTokenItem ti;
-  bool ok = TRUE;
-  int i;
-  ffelab *labels;
-
-  assert (label_toks != NULL);
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  labels = malloc_new_kp (ffesta_output_pool, "FFESTC labels",
-			  sizeof (*labels)
-			  * ffestt_tokenlist_count (label_toks));
-
-  for (ti = label_toks->first, i = 0;
-       ti != (ffesttTokenItem) &label_toks->first;
-       ti = ti->next, ++i)
-    {
-      if (!ffestc_labelref_is_branch_ (ti->t, &labels[i]))
-	{
-	  ok = FALSE;
-	  break;
-	}
-    }
-
-  if (ok)
-    ffestd_R837 (labels, ffestt_tokenlist_count (label_toks), expr);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R838 -- ASSIGN statement
-
-   ffestc_R838(label_token,target_variable,target_token);
-
-   Make sure label_token identifies a valid label for an assignment.  Update
-   that label's info to indicate it is the source of an assignment.  Update
-   target_variable's info to indicate it is the target the assignment of that
-   label.  */
-
-void
-ffestc_R838 (ffelexToken label_token, ffebld target,
-	     ffelexToken target_token UNUSED)
-{
-  ffelab label;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  /* Mark target symbol as target of an ASSIGN.  */
-  if (ffebld_op (target) == FFEBLD_opSYMTER)
-    ffesymbol_set_assigned (ffebld_symter (target), TRUE);
-
-  if (ffestc_labelref_is_assignable_ (label_token, &label))
-    ffestd_R838 (label, target);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R839 -- Assigned GOTO statement
-
-   ffestc_R839(target,target_token,label_list);
-
-   Make sure label_list identifies valid labels for a GOTO.  Update
-   each label's info to indicate it is the target of a GOTO.  */
-
-void
-ffestc_R839 (ffebld target, ffelexToken target_token UNUSED,
-	     ffesttTokenList label_toks)
-{
-  ffesttTokenItem ti;
-  bool ok = TRUE;
-  int i;
-  ffelab *labels;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  if (label_toks == NULL)
-    {
-      labels = NULL;
-      i = 0;
-    }
-  else
-    {
-      labels = malloc_new_kp (ffesta_output_pool, "FFESTC labels",
-		    sizeof (*labels) * ffestt_tokenlist_count (label_toks));
-
-      for (ti = label_toks->first, i = 0;
-	   ti != (ffesttTokenItem) &label_toks->first;
-	   ti = ti->next, ++i)
-	{
-	  if (!ffestc_labelref_is_branch_ (ti->t, &labels[i]))
-	    {
-	      ok = FALSE;
-	      break;
-	    }
-	}
-    }
-
-  if (ok)
-    ffestd_R839 (target, labels, i);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) GOTO I".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R840 -- Arithmetic IF statement
-
-   ffestc_R840(expr,expr_token,neg,zero,pos);
-
-   Make sure the labels are valid; implement.  */
-
-void
-ffestc_R840 (ffebld expr, ffelexToken expr_token UNUSED,
-	     ffelexToken neg_token, ffelexToken zero_token,
-	     ffelexToken pos_token)
-{
-  ffelab neg;
-  ffelab zero;
-  ffelab pos;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  if (ffestc_labelref_is_branch_ (neg_token, &neg)
-      && ffestc_labelref_is_branch_ (zero_token, &zero)
-      && ffestc_labelref_is_branch_ (pos_token, &pos))
-    ffestd_R840 (expr, neg, zero, pos);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) GOTO (100,200,300), I".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R841 -- CONTINUE statement
-
-   ffestc_R841();  */
-
-void
-ffestc_R841 (void)
-{
-  ffestc_check_simple_ ();
-
-  if (ffestc_order_actionwhere_ () != FFESTC_orderOK_)
-    return;
-
-  ffestc_labeldef_branch_begin_ ();
-
-  ffestd_R841 (FALSE);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R842 -- STOP statement
-
-   ffestc_R842(expr,expr_token);
-
-   Make sure statement is valid here; implement.  expr and expr_token are
-   both NULL if there was no expression.  */
-
-void
-ffestc_R842 (ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  ffestd_R842 (expr);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) STOP".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R843 -- PAUSE statement
-
-   ffestc_R843(expr,expr_token);
-
-   Make sure statement is valid here; implement.  expr and expr_token are
-   both NULL if there was no expression.  */
-
-void
-ffestc_R843 (ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  ffestd_R843 (expr);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R904 -- OPEN statement
-
-   ffestc_R904();
-
-   Make sure an OPEN is valid in the current context, and implement it.	 */
-
-void
-ffestc_R904 (void)
-{
-  int i;
-  int expect_file;
-  static const char *const status_strs[] =
-  {
-    "New",
-    "Old",
-    "Replace",
-    "Scratch",
-    "Unknown"
-  };
-  static const char *const access_strs[] =
-  {
-    "Append",
-    "Direct",
-    "Keyed",
-    "Sequential"
-  };
-  static const char *const blank_strs[] =
-  {
-    "Null",
-    "Zero"
-  };
-  static const char *const carriagecontrol_strs[] =
-  {
-    "Fortran",
-    "List",
-    "None"
-  };
-  static const char *const dispose_strs[] =
-  {
-    "Delete",
-    "Keep",
-    "Print",
-    "Print/Delete",
-    "Save",
-    "Submit",
-    "Submit/Delete"
-  };
-  static const char *const form_strs[] =
-  {
-    "Formatted",
-    "Unformatted"
-  };
-  static const char *const organization_strs[] =
-  {
-    "Indexed",
-    "Relative",
-    "Sequential"
-  };
-  static const char *const position_strs[] =
-  {
-    "Append",
-    "AsIs",
-    "Rewind"
-  };
-  static const char *const action_strs[] =
-  {
-    "Read",
-    "ReadWrite",
-    "Write"
-  };
-  static const char *const delim_strs[] =
-  {
-    "Apostrophe",
-    "None",
-    "Quote"
-  };
-  static const char *const recordtype_strs[] =
-  {
-    "Fixed",
-    "Segmented",
-    "Stream",
-    "Stream_CR",
-    "Stream_LF",
-    "Variable"
-  };
-  static const char *const pad_strs[] =
-  {
-    "No",
-    "Yes"
-  };
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  if (ffestc_subr_is_branch_
-      (&ffestp_file.open.open_spec[FFESTP_openixERR])
-      && ffestc_subr_is_present_ ("UNIT",
-			    &ffestp_file.open.open_spec[FFESTP_openixUNIT]))
-    {
-      i = ffestc_subr_binsrch_ (status_strs,
-				ARRAY_SIZE (status_strs),
-			   &ffestp_file.open.open_spec[FFESTP_openixSTATUS],
-				"NEW, OLD, REPLACE, SCRATCH, or UNKNOWN");
-      switch (i)
-	{
-	case 0:		/* Unknown. */
-	case 5:		/* UNKNOWN. */
-	  expect_file = 2;	/* Unknown, don't care about FILE=. */
-	  break;
-
-	case 1:		/* NEW. */
-	case 2:		/* OLD. */
-	  if (ffe_is_pedantic ())
-	    expect_file = 1;	/* Yes, need FILE=. */
-	  else
-	    expect_file = 2;	/* f2clib doesn't care about FILE=. */
-	  break;
-
-	case 3:		/* REPLACE. */
-	  expect_file = 1;	/* Yes, need FILE=. */
-	  break;
-
-	case 4:		/* SCRATCH. */
-	  expect_file = 0;	/* No, disallow FILE=. */
-	  break;
-
-	default:
-	  assert ("invalid _binsrch_ result" == NULL);
-	  expect_file = 0;
-	  break;
-	}
-      if ((expect_file == 0)
-	  && ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present)
-	{
-	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
-	  assert (ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present);
-	  if (ffestp_file.open.open_spec[FFESTP_openixFILE].kw_present)
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-			 (ffestp_file.open.open_spec[FFESTP_openixFILE].kw),
-			   ffelex_token_where_column
-			(ffestp_file.open.open_spec[FFESTP_openixFILE].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-		      (ffestp_file.open.open_spec[FFESTP_openixFILE].value),
-			   ffelex_token_where_column
-		     (ffestp_file.open.open_spec[FFESTP_openixFILE].value));
-	    }
-	  assert (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_or_val_present);
-	  if (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_present)
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-		       (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw),
-			   ffelex_token_where_column
-		      (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-		    (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value),
-			   ffelex_token_where_column
-		   (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value));
-	    }
-	  ffebad_finish ();
-	}
-      else if ((expect_file == 1)
-	&& !ffestp_file.open.open_spec[FFESTP_openixFILE].kw_or_val_present)
-	{
-	  ffebad_start (FFEBAD_MISSING_SPECIFIER);
-	  assert (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_or_val_present);
-	  if (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw_present)
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-		       (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw),
-			   ffelex_token_where_column
-		      (ffestp_file.open.open_spec[FFESTP_openixSTATUS].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-		    (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value),
-			   ffelex_token_where_column
-		   (ffestp_file.open.open_spec[FFESTP_openixSTATUS].value));
-	    }
-	  ffebad_string ("FILE=");
-	  ffebad_finish ();
-	}
-
-      ffestc_subr_binsrch_ (access_strs, ARRAY_SIZE (access_strs),
-			    &ffestp_file.open.open_spec[FFESTP_openixACCESS],
-			    "APPEND, DIRECT, KEYED, or SEQUENTIAL");
-
-      ffestc_subr_binsrch_ (blank_strs, ARRAY_SIZE (blank_strs),
-			    &ffestp_file.open.open_spec[FFESTP_openixBLANK],
-			    "NULL or ZERO");
-
-      ffestc_subr_binsrch_ (carriagecontrol_strs,
-			    ARRAY_SIZE (carriagecontrol_strs),
-		  &ffestp_file.open.open_spec[FFESTP_openixCARRIAGECONTROL],
-			    "FORTRAN, LIST, or NONE");
-
-      ffestc_subr_binsrch_ (dispose_strs, ARRAY_SIZE (dispose_strs),
-			  &ffestp_file.open.open_spec[FFESTP_openixDISPOSE],
-       "DELETE, KEEP, PRINT, PRINT/DELETE, SAVE, SUBMIT, or SUBMIT/DELETE");
-
-      ffestc_subr_binsrch_ (form_strs, ARRAY_SIZE (form_strs),
-			    &ffestp_file.open.open_spec[FFESTP_openixFORM],
-			    "FORMATTED or UNFORMATTED");
-
-      ffestc_subr_binsrch_ (organization_strs, ARRAY_SIZE (organization_strs),
-		     &ffestp_file.open.open_spec[FFESTP_openixORGANIZATION],
-			    "INDEXED, RELATIVE, or SEQUENTIAL");
-
-      ffestc_subr_binsrch_ (position_strs, ARRAY_SIZE (position_strs),
-			 &ffestp_file.open.open_spec[FFESTP_openixPOSITION],
-			    "APPEND, ASIS, or REWIND");
-
-      ffestc_subr_binsrch_ (action_strs, ARRAY_SIZE (action_strs),
-			    &ffestp_file.open.open_spec[FFESTP_openixACTION],
-			    "READ, READWRITE, or WRITE");
-
-      ffestc_subr_binsrch_ (delim_strs, ARRAY_SIZE (delim_strs),
-			    &ffestp_file.open.open_spec[FFESTP_openixDELIM],
-			    "APOSTROPHE, NONE, or QUOTE");
-
-      ffestc_subr_binsrch_ (recordtype_strs, ARRAY_SIZE (recordtype_strs),
-		       &ffestp_file.open.open_spec[FFESTP_openixRECORDTYPE],
-	     "FIXED, SEGMENTED, STREAM, STREAM_CR, STREAM_LF, or VARIABLE");
-
-      ffestc_subr_binsrch_ (pad_strs, ARRAY_SIZE (pad_strs),
-			    &ffestp_file.open.open_spec[FFESTP_openixPAD],
-			    "NO or YES");
-
-      ffestd_R904 ();
-    }
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R907 -- CLOSE statement
-
-   ffestc_R907();
-
-   Make sure a CLOSE is valid in the current context, and implement it.	 */
-
-void
-ffestc_R907 (void)
-{
-  static const char *const status_strs[] =
-  {
-    "Delete",
-    "Keep",
-    "Print",
-    "Print/Delete",
-    "Save",
-    "Submit",
-    "Submit/Delete"
-  };
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  if (ffestc_subr_is_branch_
-      (&ffestp_file.close.close_spec[FFESTP_closeixERR])
-      && ffestc_subr_is_present_ ("UNIT",
-			 &ffestp_file.close.close_spec[FFESTP_closeixUNIT]))
-    {
-      ffestc_subr_binsrch_ (status_strs, ARRAY_SIZE (status_strs),
-			&ffestp_file.close.close_spec[FFESTP_closeixSTATUS],
-       "DELETE, KEEP, PRINT, PRINT/DELETE, SAVE, SUBMIT, or SUBMIT/DELETE");
-
-      ffestd_R907 ();
-    }
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R909_start -- READ(...) statement list begin
-
-   ffestc_R909_start(FALSE);
-
-   Verify that READ is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R909_start (bool only_format)
-{
-  ffestvUnit unit;
-  ffestvFormat format;
-  bool rec;
-  bool key;
-  ffestpReadIx keyn;
-  ffestpReadIx spec1;
-  ffestpReadIx spec2;
-
-  ffestc_check_start_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_branch_begin_ ();
-
-  if (!ffestc_subr_is_format_
-      (&ffestp_file.read.read_spec[FFESTP_readixFORMAT]))
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  format = ffestc_subr_format_
-    (&ffestp_file.read.read_spec[FFESTP_readixFORMAT]);
-  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
-
-  if (only_format)
-    {
-      ffestd_R909_start (TRUE, FFESTV_unitNONE, format, FALSE, FALSE);
-
-      ffestc_ok_ = TRUE;
-      return;
-    }
-
-  if (!ffestc_subr_is_branch_
-      (&ffestp_file.read.read_spec[FFESTP_readixEOR])
-      || !ffestc_subr_is_branch_
-      (&ffestp_file.read.read_spec[FFESTP_readixERR])
-      || !ffestc_subr_is_branch_
-      (&ffestp_file.read.read_spec[FFESTP_readixEND]))
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  unit = ffestc_subr_unit_
-    (&ffestp_file.read.read_spec[FFESTP_readixUNIT]);
-  if (unit == FFESTV_unitNONE)
-    {
-      ffebad_start (FFEBAD_NO_UNIT_SPEC);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  rec = ffestp_file.read.read_spec[FFESTP_readixREC].kw_or_val_present;
-
-  if (ffestp_file.read.read_spec[FFESTP_readixKEYEQ].kw_or_val_present)
-    {
-      key = TRUE;
-      keyn = spec1 = FFESTP_readixKEYEQ;
-    }
-  else
-    {
-      key = FALSE;
-      keyn = spec1 = FFESTP_readix;
-    }
-
-  if (ffestp_file.read.read_spec[FFESTP_readixKEYGT].kw_or_val_present)
-    {
-      if (key)
-	{
-	  spec2 = FFESTP_readixKEYGT;
-	whine:			/* :::::::::::::::::::: */
-	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
-	  assert (ffestp_file.read.read_spec[spec1].kw_or_val_present);
-	  if (ffestp_file.read.read_spec[spec1].kw_present)
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-			   (ffestp_file.read.read_spec[spec1].kw),
-			   ffelex_token_where_column
-			   (ffestp_file.read.read_spec[spec1].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-			   (ffestp_file.read.read_spec[spec1].value),
-			   ffelex_token_where_column
-			   (ffestp_file.read.read_spec[spec1].value));
-	    }
-	  assert (ffestp_file.read.read_spec[spec2].kw_or_val_present);
-	  if (ffestp_file.read.read_spec[spec2].kw_present)
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-			   (ffestp_file.read.read_spec[spec2].kw),
-			   ffelex_token_where_column
-			   (ffestp_file.read.read_spec[spec2].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-			   (ffestp_file.read.read_spec[spec2].value),
-			   ffelex_token_where_column
-			   (ffestp_file.read.read_spec[spec2].value));
-	    }
-	  ffebad_finish ();
-	  ffestc_ok_ = FALSE;
-	  return;
-	}
-      key = TRUE;
-      keyn = spec1 = FFESTP_readixKEYGT;
-    }
-
-  if (ffestp_file.read.read_spec[FFESTP_readixKEYGE].kw_or_val_present)
-    {
-      if (key)
-	{
-	  spec2 = FFESTP_readixKEYGT;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      key = TRUE;
-      keyn = FFESTP_readixKEYGT;
-    }
-
-  if (rec)
-    {
-      spec1 = FFESTP_readixREC;
-      if (key)
-	{
-	  spec2 = keyn;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (unit == FFESTV_unitCHAREXPR)
-	{
-	  spec2 = FFESTP_readixUNIT;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if ((format == FFESTV_formatASTERISK)
-	  || (format == FFESTV_formatNAMELIST))
-	{
-	  spec2 = FFESTP_readixFORMAT;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixADVANCE;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixEND].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixEND;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixNULLS;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-    }
-  else if (key)
-    {
-      spec1 = keyn;
-      if (unit == FFESTV_unitCHAREXPR)
-	{
-	  spec2 = FFESTP_readixUNIT;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if ((format == FFESTV_formatASTERISK)
-	  || (format == FFESTV_formatNAMELIST))
-	{
-	  spec2 = FFESTP_readixFORMAT;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixADVANCE;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixEND].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixEND;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixEOR].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixEOR;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixNULLS;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixREC].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixREC;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixSIZE].kw_or_val_present)
-	{
-	  spec2 = FFESTP_readixSIZE;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-    }
-  else
-    {				/* Sequential/Internal. */
-      if (unit == FFESTV_unitCHAREXPR)
-	{			/* Internal file. */
-	  spec1 = FFESTP_readixUNIT;
-	  if (format == FFESTV_formatNAMELIST)
-	    {
-	      spec2 = FFESTP_readixFORMAT;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	  if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
-	    {
-	      spec2 = FFESTP_readixADVANCE;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw_or_val_present)
-	{			/* ADVANCE= specified. */
-	  spec1 = FFESTP_readixADVANCE;
-	  if (format == FFESTV_formatNONE)
-	    {
-	      ffebad_start (FFEBAD_MISSING_FORMAT_SPEC);
-	      ffebad_here (0, ffelex_token_where_line
-			   (ffestp_file.read.read_spec[spec1].kw),
-			   ffelex_token_where_column
-			   (ffestp_file.read.read_spec[spec1].kw));
-	      ffebad_finish ();
-
-	      ffestc_ok_ = FALSE;
-	      return;
-	    }
-	  if (format == FFESTV_formatNAMELIST)
-	    {
-	      spec2 = FFESTP_readixFORMAT;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixEOR].kw_or_val_present)
-	{			/* EOR= specified. */
-	  spec1 = FFESTP_readixEOR;
-	  if (ffestc_subr_speccmp_ ("No",
-			  &ffestp_file.read.read_spec[FFESTP_readixADVANCE],
-				    NULL, NULL) != 0)
-	    {
-	      goto whine_advance;	/* :::::::::::::::::::: */
-	    }
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixNULLS].kw_or_val_present)
-	{			/* NULLS= specified. */
-	  spec1 = FFESTP_readixNULLS;
-	  if (format != FFESTV_formatASTERISK)
-	    {
-	      spec2 = FFESTP_readixFORMAT;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	}
-      if (ffestp_file.read.read_spec[FFESTP_readixSIZE].kw_or_val_present)
-	{			/* SIZE= specified. */
-	  spec1 = FFESTP_readixSIZE;
-	  if (ffestc_subr_speccmp_ ("No",
-			  &ffestp_file.read.read_spec[FFESTP_readixADVANCE],
-				    NULL, NULL) != 0)
-	    {
-	    whine_advance:	/* :::::::::::::::::::: */
-	      if (ffestp_file.read.read_spec[FFESTP_readixADVANCE]
-		  .kw_or_val_present)
-		{
-		  ffebad_start (FFEBAD_CONFLICTING_SPECS);
-		  ffebad_here (0, ffelex_token_where_line
-			       (ffestp_file.read.read_spec[spec1].kw),
-			       ffelex_token_where_column
-			       (ffestp_file.read.read_spec[spec1].kw));
-		  ffebad_here (1, ffelex_token_where_line
-		      (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw),
-			       ffelex_token_where_column
-		     (ffestp_file.read.read_spec[FFESTP_readixADVANCE].kw));
-		  ffebad_finish ();
-		}
-	      else
-		{
-		  ffebad_start (FFEBAD_MISSING_ADVANCE_SPEC);
-		  ffebad_here (0, ffelex_token_where_line
-			       (ffestp_file.read.read_spec[spec1].kw),
-			       ffelex_token_where_column
-			       (ffestp_file.read.read_spec[spec1].kw));
-		  ffebad_finish ();
-		}
-
-	      ffestc_ok_ = FALSE;
-	      return;
-	    }
-	}
-    }
-
-  if (unit == FFESTV_unitCHAREXPR)
-    ffestc_iolist_context_ = FFEEXPR_contextIOLISTDF;
-  else
-    ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
-
-  ffestd_R909_start (FALSE, unit, format, rec, key);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R909_item -- READ statement i/o item
-
-   ffestc_R909_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestc_R909_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_R909_item (expr, expr_token);
-}
-
-/* ffestc_R909_finish -- READ statement list complete
-
-   ffestc_R909_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R909_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R909_finish ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R910_start -- WRITE(...) statement list begin
-
-   ffestc_R910_start();
-
-   Verify that WRITE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R910_start (void)
-{
-  ffestvUnit unit;
-  ffestvFormat format;
-  bool rec;
-  ffestpWriteIx spec1;
-  ffestpWriteIx spec2;
-
-  ffestc_check_start_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_branch_begin_ ();
-
-  if (!ffestc_subr_is_branch_
-      (&ffestp_file.write.write_spec[FFESTP_writeixEOR])
-      || !ffestc_subr_is_branch_
-      (&ffestp_file.write.write_spec[FFESTP_writeixERR])
-      || !ffestc_subr_is_format_
-      (&ffestp_file.write.write_spec[FFESTP_writeixFORMAT]))
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  format = ffestc_subr_format_
-    (&ffestp_file.write.write_spec[FFESTP_writeixFORMAT]);
-  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
-
-  unit = ffestc_subr_unit_
-    (&ffestp_file.write.write_spec[FFESTP_writeixUNIT]);
-  if (unit == FFESTV_unitNONE)
-    {
-      ffebad_start (FFEBAD_NO_UNIT_SPEC);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  rec = ffestp_file.write.write_spec[FFESTP_writeixREC].kw_or_val_present;
-
-  if (rec)
-    {
-      spec1 = FFESTP_writeixREC;
-      if (unit == FFESTV_unitCHAREXPR)
-	{
-	  spec2 = FFESTP_writeixUNIT;
-	whine:			/* :::::::::::::::::::: */
-	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
-	  assert (ffestp_file.write.write_spec[spec1].kw_or_val_present);
-	  if (ffestp_file.write.write_spec[spec1].kw_present)
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-			   (ffestp_file.write.write_spec[spec1].kw),
-			   ffelex_token_where_column
-			   (ffestp_file.write.write_spec[spec1].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-			   (ffestp_file.write.write_spec[spec1].value),
-			   ffelex_token_where_column
-			   (ffestp_file.write.write_spec[spec1].value));
-	    }
-	  assert (ffestp_file.write.write_spec[spec2].kw_or_val_present);
-	  if (ffestp_file.write.write_spec[spec2].kw_present)
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-			   (ffestp_file.write.write_spec[spec2].kw),
-			   ffelex_token_where_column
-			   (ffestp_file.write.write_spec[spec2].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-			   (ffestp_file.write.write_spec[spec2].value),
-			   ffelex_token_where_column
-			   (ffestp_file.write.write_spec[spec2].value));
-	    }
-	  ffebad_finish ();
-	  ffestc_ok_ = FALSE;
-	  return;
-	}
-      if ((format == FFESTV_formatASTERISK)
-	  || (format == FFESTV_formatNAMELIST))
-	{
-	  spec2 = FFESTP_writeixFORMAT;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-      if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
-	{
-	  spec2 = FFESTP_writeixADVANCE;
-	  goto whine;		/* :::::::::::::::::::: */
-	}
-    }
-  else
-    {				/* Sequential/Indexed/Internal. */
-      if (unit == FFESTV_unitCHAREXPR)
-	{			/* Internal file. */
-	  spec1 = FFESTP_writeixUNIT;
-	  if (format == FFESTV_formatNAMELIST)
-	    {
-	      spec2 = FFESTP_writeixFORMAT;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	  if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
-	    {
-	      spec2 = FFESTP_writeixADVANCE;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	}
-      if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw_or_val_present)
-	{			/* ADVANCE= specified. */
-	  spec1 = FFESTP_writeixADVANCE;
-	  if (format == FFESTV_formatNONE)
-	    {
-	      ffebad_start (FFEBAD_MISSING_FORMAT_SPEC);
-	      ffebad_here (0, ffelex_token_where_line
-			   (ffestp_file.write.write_spec[spec1].kw),
-			   ffelex_token_where_column
-			   (ffestp_file.write.write_spec[spec1].kw));
-	      ffebad_finish ();
-
-	      ffestc_ok_ = FALSE;
-	      return;
-	    }
-	  if (format == FFESTV_formatNAMELIST)
-	    {
-	      spec2 = FFESTP_writeixFORMAT;
-	      goto whine;	/* :::::::::::::::::::: */
-	    }
-	}
-      if (ffestp_file.write.write_spec[FFESTP_writeixEOR].kw_or_val_present)
-	{			/* EOR= specified. */
-	  spec1 = FFESTP_writeixEOR;
-	  if (ffestc_subr_speccmp_ ("No",
-		       &ffestp_file.write.write_spec[FFESTP_writeixADVANCE],
-				    NULL, NULL) != 0)
-	    {
-	      if (ffestp_file.write.write_spec[FFESTP_writeixADVANCE]
-		  .kw_or_val_present)
-		{
-		  ffebad_start (FFEBAD_CONFLICTING_SPECS);
-		  ffebad_here (0, ffelex_token_where_line
-			       (ffestp_file.write.write_spec[spec1].kw),
-			       ffelex_token_where_column
-			       (ffestp_file.write.write_spec[spec1].kw));
-		  ffebad_here (1, ffelex_token_where_line
-		   (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw),
-			       ffelex_token_where_column
-		  (ffestp_file.write.write_spec[FFESTP_writeixADVANCE].kw));
-		  ffebad_finish ();
-		}
-	      else
-		{
-		  ffebad_start (FFEBAD_MISSING_ADVANCE_SPEC);
-		  ffebad_here (0, ffelex_token_where_line
-			       (ffestp_file.write.write_spec[spec1].kw),
-			       ffelex_token_where_column
-			       (ffestp_file.write.write_spec[spec1].kw));
-		  ffebad_finish ();
-		}
-
-	      ffestc_ok_ = FALSE;
-	      return;
-	    }
-	}
-    }
-
-  if (unit == FFESTV_unitCHAREXPR)
-    ffestc_iolist_context_ = FFEEXPR_contextIOLISTDF;
-  else
-    ffestc_iolist_context_ = FFEEXPR_contextIOLIST;
-
-  ffestd_R910_start (unit, format, rec);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R910_item -- WRITE statement i/o item
-
-   ffestc_R910_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestc_R910_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_R910_item (expr, expr_token);
-}
-
-/* ffestc_R910_finish -- WRITE statement list complete
-
-   ffestc_R910_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R910_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R910_finish ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R911_start -- PRINT(...) statement list begin
-
-   ffestc_R911_start();
-
-   Verify that PRINT is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R911_start (void)
-{
-  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.print.print_spec[FFESTP_printixFORMAT]))
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  format = ffestc_subr_format_
-    (&ffestp_file.print.print_spec[FFESTP_printixFORMAT]);
-  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
-
-  ffestd_R911_start (format);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R911_item -- PRINT statement i/o item
-
-   ffestc_R911_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestc_R911_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_R911_item (expr, expr_token);
-}
-
-/* ffestc_R911_finish -- PRINT statement list complete
-
-   ffestc_R911_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R911_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R911_finish ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R919 -- BACKSPACE statement
-
-   ffestc_R919();
-
-   Make sure a BACKSPACE is valid in the current context, and implement it.  */
-
-void
-ffestc_R919 (void)
-{
-  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_R919 ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R920 -- ENDFILE statement
-
-   ffestc_R920();
-
-   Make sure a ENDFILE is valid in the current context, and implement it.  */
-
-void
-ffestc_R920 (void)
-{
-  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_R920 ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R921 -- REWIND statement
-
-   ffestc_R921();
-
-   Make sure a REWIND is valid in the current context, and implement it.  */
-
-void
-ffestc_R921 (void)
-{
-  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_R921 ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R923A -- INQUIRE statement (non-IOLENGTH version)
-
-   ffestc_R923A();
-
-   Make sure an INQUIRE is valid in the current context, and implement it.  */
-
-void
-ffestc_R923A (void)
-{
-  bool by_file;
-  bool by_unit;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  if (ffestc_subr_is_branch_
-      (&ffestp_file.inquire.inquire_spec[FFESTP_inquireixERR]))
-    {
-      by_file = ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE]
-	.kw_or_val_present;
-      by_unit = ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT]
-	.kw_or_val_present;
-      if (by_file && by_unit)
-	{
-	  ffebad_start (FFEBAD_CONFLICTING_SPECS);
-	  assert (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_or_val_present);
-	  if (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw_present)
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-		(ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw),
-			   ffelex_token_where_column
-	       (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (0, ffelex_token_where_line
-	      (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value),
-			   ffelex_token_where_column
-			   (ffestp_file.inquire.inquire_spec[FFESTP_inquireixUNIT].value));
-	    }
-	  assert (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw_or_val_present);
-	  if (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw_present)
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-		(ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw),
-			   ffelex_token_where_column
-	       (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].kw));
-	    }
-	  else
-	    {
-	      ffebad_here (1, ffelex_token_where_line
-	      (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].value),
-			   ffelex_token_where_column
-			   (ffestp_file.inquire.inquire_spec[FFESTP_inquireixFILE].value));
-	    }
-	  ffebad_finish ();
-	}
-      else if (!by_file && !by_unit)
-	{
-	  ffebad_start (FFEBAD_MISSING_SPECIFIER);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_string ("UNIT= or FILE=");
-	  ffebad_finish ();
-	}
-      else
-	ffestd_R923A (by_file);
-    }
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
-
-   ffestc_R923B_start();
-
-   Verify that INQUIRE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_R923B_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_branch_begin_ ();
-
-  ffestd_R923B_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R923B_item -- INQUIRE statement i/o item
-
-   ffestc_R923B_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestc_R923B_item (ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R923B_item (expr);
-}
-
-/* ffestc_R923B_finish -- INQUIRE statement list complete
-
-   ffestc_R923B_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R923B_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R923B_finish ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R1001 -- FORMAT statement
-
-   ffestc_R1001(format_list);
-
-   Make sure format_list is valid.  Update label's info to indicate it is a
-   FORMAT label, and (perhaps) warn if there is no label!  */
-
-void
-ffestc_R1001 (ffesttFormatList f)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_format_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_format_ ();
-
-  ffestd_R1001 (f);
-}
-
-/* ffestc_R1102 -- PROGRAM statement
-
-   ffestc_R1102(name_token);
-
-   Make sure ffestc_kind_ identifies an empty block.  Make sure name_token
-   gives a valid name.	Implement the beginning of a main program.  */
-
-void
-ffestc_R1102 (ffelexToken name)
-{
-  ffestw b;
-  ffesymbol s;
-
-  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_statePROGRAM0);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_end_program_);
-
-  ffestw_set_name (b, ffelex_token_use (name));
-
-  s = ffesymbol_declare_programunit (name,
-				 ffelex_token_where_line (ffesta_tokens[0]),
-			      ffelex_token_where_column (ffesta_tokens[0]));
-
-  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-    {
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_set_info (s,
-			  ffeinfo_new (FFEINFO_basictypeNONE,
-				       FFEINFO_kindtypeNONE,
-				       0,
-				       FFEINFO_kindPROGRAM,
-				       FFEINFO_whereLOCAL,
-				       FFETARGET_charactersizeNONE));
-      ffesymbol_signal_unreported (s);
-    }
-  else
-    ffesymbol_error (s, name);
-
-  ffestd_R1102 (s, name);
-}
-
-/* ffestc_R1103 -- END PROGRAM statement
-
-   ffestc_R1103(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_R1103 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_program_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  if (name != NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_PROGRAM_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (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_end_program_ (TRUE);
-}
-
-/* ffestc_R1111 -- BLOCK DATA statement
-
-   ffestc_R1111(name_token);
-
-   Make sure ffestc_kind_ identifies no current program unit.  If not
-   NULL, make sure name_token gives a valid name.  Implement the beginning
-   of a block data program unit.  */
-
-void
-ffestc_R1111 (ffelexToken name)
-{
-  ffestw b;
-  ffesymbol s;
-
-  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_stateBLOCKDATA0);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_blockdata_);
-
-  if (name == NULL)
-    ffestw_set_name (b, NULL);
-  else
-    ffestw_set_name (b, ffelex_token_use (name));
-
-  s = ffesymbol_declare_blockdataunit (name,
-				 ffelex_token_where_line (ffesta_tokens[0]),
-			      ffelex_token_where_column (ffesta_tokens[0]));
-
-  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-    {
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_set_info (s,
-			  ffeinfo_new (FFEINFO_basictypeNONE,
-				       FFEINFO_kindtypeNONE,
-				       0,
-				       FFEINFO_kindBLOCKDATA,
-				       FFEINFO_whereLOCAL,
-				       FFETARGET_charactersizeNONE));
-      ffesymbol_signal_unreported (s);
-    }
-  else
-    ffesymbol_error (s, name);
-
-  ffestd_R1111 (s, name);
-}
-
-/* ffestc_R1112 -- END BLOCK DATA statement
-
-   ffestc_R1112(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_R1112 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_blockdata_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  if (name != NULL)
-    {
-      if (ffestw_name (ffestw_stack_top ()) == NULL)
-	{
-	  ffebad_start (FFEBAD_BLOCKDATA_NOT_NAMED);
-	  ffebad_here (0, ffelex_token_where_line (name),
-		       ffelex_token_where_column (name));
-	  ffebad_here (1, ffestw_line (ffestw_stack_top ()), ffestw_col (ffestw_stack_top ()));
-	  ffebad_finish ();
-	}
-      else if (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_blockdata_ (TRUE);
-}
-
-/* ffestc_R1207_start -- EXTERNAL statement list begin
-
-   ffestc_R1207_start();
-
-   Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
-
-void
-ffestc_R1207_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestd_R1207_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R1207_item -- EXTERNAL statement for name
-
-   ffestc_R1207_item(name_token);
-
-   Make sure name_token identifies a valid object to be EXTERNALd.  */
-
-void
-ffestc_R1207_item (ffelexToken name)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  s = ffesymbol_declare_local (name, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;
-  else if (!(sa & ~(FFESYMBOL_attrsDUMMY
-		    | FFESYMBOL_attrsTYPE)))
-    na = sa | FFESYMBOL_attrsEXTERNAL;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, name);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_set_explicitwhere (s, TRUE);
-      ffesymbol_reference (s, name, FALSE);
-      ffesymbol_signal_unreported (s);
-    }
-
-  ffestd_R1207_item (name);
-}
-
-/* ffestc_R1207_finish -- EXTERNAL statement list complete
-
-   ffestc_R1207_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R1207_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R1207_finish ();
-}
-
-/* ffestc_R1208_start -- INTRINSIC statement list begin
-
-   ffestc_R1208_start();
-
-   Verify that INTRINSIC is valid here, and begin accepting items in the list.	*/
-
-void
-ffestc_R1208_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestd_R1208_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R1208_item -- INTRINSIC statement for name
-
-   ffestc_R1208_item(name_token);
-
-   Make sure name_token identifies a valid object to be INTRINSICd.  */
-
-void
-ffestc_R1208_item (ffelexToken name)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  s = ffesymbol_declare_local (name, TRUE);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = sa;
-  else if (!(sa & ~FFESYMBOL_attrsTYPE))
-    {
-      if (ffeintrin_is_intrinsic (ffelex_token_text (name), name, TRUE,
-				  &gen, &spec, &imp)
-	  && ((imp == FFEINTRIN_impNONE)
-#if 0	/* Don't bother with this for now. */
-	      || ((ffeintrin_basictype (spec)
-		   == ffesymbol_basictype (s))
-		  && (ffeintrin_kindtype (spec)
-		      == ffesymbol_kindtype (s)))
-#else
-	      || 1
-#endif
-	      || !(sa & FFESYMBOL_attrsTYPE)))
-	na = sa | FFESYMBOL_attrsINTRINSIC;
-      else
-	na = FFESYMBOL_attrsetNONE;
-    }
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, name);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_set_generic (s, gen);
-      ffesymbol_set_specific (s, spec);
-      ffesymbol_set_implementation (s, imp);
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       0,
-				       FFEINFO_kindNONE,
-				       FFEINFO_whereINTRINSIC,
-				       ffesymbol_size (s)));
-      ffesymbol_set_explicitwhere (s, TRUE);
-      ffesymbol_reference (s, name, TRUE);
-    }
-
-  ffesymbol_signal_unreported (s);
-
-  ffestd_R1208_item (name);
-}
-
-/* ffestc_R1208_finish -- INTRINSIC statement list complete
-
-   ffestc_R1208_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_R1208_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_R1208_finish ();
-}
-
-/* ffestc_R1212 -- CALL statement
-
-   ffestc_R1212(expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestc_R1212 (ffebld expr, ffelexToken expr_token UNUSED)
-{
-  ffebld item;			/* ITEM. */
-  ffebld labexpr;		/* LABTOK=>LABTER. */
-  ffelab label;
-  bool ok;			/* TRUE if all LABTOKs were ok. */
-  bool ok1;			/* TRUE if a particular LABTOK is ok. */
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_branch_begin_ ();
-
-  if (ffebld_op (expr) != FFEBLD_opSUBRREF)
-    ffestd_R841 (FALSE);	/* CONTINUE. */
-  else
-    {
-      ok = TRUE;
-
-      for (item = ffebld_right (expr);
-	   item != NULL;
-	   item = ffebld_trail (item))
-	{
-	  if (((labexpr = ffebld_head (item)) != NULL)
-	      && (ffebld_op (labexpr) == FFEBLD_opLABTOK))
-	    {
-	      ok1 = ffestc_labelref_is_branch_ (ffebld_labtok (labexpr),
-						&label);
-	      ffelex_token_kill (ffebld_labtok (labexpr));
-	      if (!ok1)
-		{
-		  label = NULL;
-		  ok = FALSE;
-		}
-	      ffebld_set_op (labexpr, FFEBLD_opLABTER);
-	      ffebld_set_labter (labexpr, label);
-	    }
-	}
-
-      if (ok)
-	ffestd_R1212 (expr);
-    }
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R1219 -- FUNCTION statement
-
-   ffestc_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
-	 recursive);
-
-   Make sure statement is valid here, register arguments for the
-   function name, and so on.
-
-   06-Apr-90  JCB  2.0
-      Added the kind, len, and recursive arguments.  */
-
-void
-ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
-	      ffelexToken final UNUSED, ffestpType type, ffebld kind,
-	      ffelexToken kindt, ffebld len, ffelexToken lent,
-	      ffelexToken recursive, ffelexToken result)
-{
-  ffestw b;
-  ffesymbol s;
-  ffesymbol fs;			/* FUNCTION symbol when dealing with RESULT
-				   symbol. */
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffelexToken res;
-  bool separate_result;
-
-  assert ((funcname != NULL)
-	  && (ffelex_token_type (funcname) == FFELEX_typeNAME));
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_iface_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  ffestc_blocknum_ = 0;
-  ffesta_is_entry_valid =
-    (ffestw_state (ffestw_stack_top ()) == FFESTV_stateNIL);
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, NULL);
-  ffestw_set_state (b, FFESTV_stateFUNCTION0);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_function_);
-  ffestw_set_name (b, ffelex_token_use (funcname));
-
-  if (type == FFESTP_typeNone)
-    {
-      ffestc_local_.decl.basic_type = FFEINFO_basictypeNONE;
-      ffestc_local_.decl.kind_type = FFEINFO_kindtypeNONE;
-      ffestc_local_.decl.size = FFETARGET_charactersizeNONE;
-    }
-  else
-    {
-      ffestc_establish_declstmt_ (type, ffesta_tokens[0],
-				  kind, kindt, len, lent);
-      ffestc_establish_declinfo_ (NULL, NULL, NULL, NULL);
-    }
-
-  separate_result = (result != NULL)
-    && (ffelex_token_strcmp (funcname, result) != 0);
-
-  if (separate_result)
-    fs = ffesymbol_declare_funcnotresunit (funcname);	/* Global/local. */
-  else
-    fs = ffesymbol_declare_funcunit (funcname);	/* Global only. */
-
-  if (ffesymbol_state (fs) == FFESYMBOL_stateNONE)
-    {
-      ffesymbol_set_state (fs, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_signal_unreported (fs);
-
-      /* Note that .basic_type and .kind_type might be NONE here. */
-
-      ffesymbol_set_info (fs,
-			  ffeinfo_new (ffestc_local_.decl.basic_type,
-				       ffestc_local_.decl.kind_type,
-				       0,
-				       FFEINFO_kindFUNCTION,
-				       FFEINFO_whereLOCAL,
-				       ffestc_local_.decl.size));
-
-      /* Check whether the type info fits the filewide expectations;
-	 set ok flag accordingly.  */
-
-      ffesymbol_reference (fs, funcname, FALSE);
-      if (ffesymbol_attrs (fs) & FFESYMBOL_attrsANY)
-	ffestc_parent_ok_ = FALSE;
-      else
-	ffestc_parent_ok_ = TRUE;
-    }
-  else
-    {
-      if (ffesymbol_kind (fs) != FFEINFO_kindANY)
-	ffesymbol_error (fs, funcname);
-      ffestc_parent_ok_ = FALSE;
-    }
-
-  if (ffestc_parent_ok_)
-    {
-      ffebld_init_list (&fs->dummy_args, &ffestc_local_.dummy.list_bottom);
-      ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
-      ffebld_end_list (&ffestc_local_.dummy.list_bottom);
-    }
-
-  if (result == NULL)
-    res = funcname;
-  else
-    res = result;
-
-  s = ffesymbol_declare_funcresult (res);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;
-  else if (ffesymbol_state (s) != FFESYMBOL_stateNONE)
-    na = FFESYMBOL_attrsetNONE;
-  else
-    {
-      na = FFESYMBOL_attrsRESULT;
-      if (ffestc_local_.decl.basic_type != FFEINFO_basictypeNONE)
-	{
-	  na |= FFESYMBOL_attrsTYPE;
-	  if ((ffestc_local_.decl.basic_type == FFEINFO_basictypeCHARACTER)
-	      && (ffestc_local_.decl.size == FFETARGET_charactersizeNONE))
-	    na |= FFESYMBOL_attrsANYLEN;
-	}
-    }
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if ((na & ~FFESYMBOL_attrsANY) == FFESYMBOL_attrsetNONE)
-    {
-      if (!(na & FFESYMBOL_attrsANY))
-	ffesymbol_error (s, res);
-      ffesymbol_set_funcresult (fs, NULL);
-      ffesymbol_set_funcresult (s, NULL);
-      ffestc_parent_ok_ = FALSE;
-    }
-  else
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      ffesymbol_set_funcresult (fs, s);
-      ffesymbol_set_funcresult (s, fs);
-      if (ffestc_local_.decl.basic_type != FFEINFO_basictypeNONE)
-	{
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (ffestc_local_.decl.basic_type,
-					   ffestc_local_.decl.kind_type,
-					   0,
-					   FFEINFO_kindNONE,
-					   FFEINFO_whereNONE,
-					   ffestc_local_.decl.size));
-	}
-    }
-
-  ffesymbol_signal_unreported (fs);
-
-  ffestd_R1219 (fs, funcname, args, type, kind, kindt, len, lent,
-		(recursive != NULL), result, separate_result);
-}
-
-/* ffestc_R1221 -- END FUNCTION statement
-
-   ffestc_R1221(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_R1221 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_function_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  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_function_ (TRUE);
-}
-
-/* ffestc_R1223 -- SUBROUTINE statement
-
-   ffestc_R1223(subrname,arglist,ending_token,recursive_token);
-
-   Make sure statement is valid here, register arguments for the
-   subroutine name, and so on.
-
-   06-Apr-90  JCB  2.0
-      Added the recursive argument.  */
-
-void
-ffestc_R1223 (ffelexToken subrname, ffesttTokenList args,
-	      ffelexToken final, ffelexToken recursive)
-{
-  ffestw b;
-  ffesymbol s;
-
-  assert ((subrname != NULL)
-	  && (ffelex_token_type (subrname) == FFELEX_typeNAME));
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_iface_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  ffestc_blocknum_ = 0;
-  ffesta_is_entry_valid
-    = (ffestw_state (ffestw_stack_top ()) == FFESTV_stateNIL);
-  b = ffestw_update (ffestw_push (NULL));
-  ffestw_set_top_do (b, NULL);
-  ffestw_set_state (b, FFESTV_stateSUBROUTINE0);
-  ffestw_set_blocknum (b, ffestc_blocknum_++);
-  ffestw_set_shriek (b, ffestc_shriek_subroutine_);
-  ffestw_set_name (b, ffelex_token_use (subrname));
-
-  s = ffesymbol_declare_subrunit (subrname);
-  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-    {
-      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-      ffesymbol_set_info (s,
-			  ffeinfo_new (FFEINFO_basictypeNONE,
-				       FFEINFO_kindtypeNONE,
-				       0,
-				       FFEINFO_kindSUBROUTINE,
-				       FFEINFO_whereLOCAL,
-				       FFETARGET_charactersizeNONE));
-      ffestc_parent_ok_ = TRUE;
-    }
-  else
-    {
-      if (ffesymbol_kind (s) != FFEINFO_kindANY)
-	ffesymbol_error (s, subrname);
-      ffestc_parent_ok_ = FALSE;
-    }
-
-  if (ffestc_parent_ok_)
-    {
-      ffebld_init_list (&s->dummy_args, &ffestc_local_.dummy.list_bottom);
-      ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
-      ffebld_end_list (&ffestc_local_.dummy.list_bottom);
-    }
-
-  ffesymbol_signal_unreported (s);
-
-  ffestd_R1223 (s, subrname, args, final, (recursive != NULL));
-}
-
-/* ffestc_R1225 -- END SUBROUTINE statement
-
-   ffestc_R1225(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_R1225 (ffelexToken name)
-{
-  ffestc_check_simple_ ();
-  if (ffestc_order_subroutine_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_ ();
-
-  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_subroutine_ (TRUE);
-}
-
-/* ffestc_R1226 -- ENTRY statement
-
-   ffestc_R1226(entryname,arglist,ending_token);
-
-   Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
-   entry point name, and so on.	 */
-
-void
-ffestc_R1226 (ffelexToken entryname, ffesttTokenList args,
-	      ffelexToken final UNUSED)
-{
-  ffesymbol s;
-  ffesymbol fs;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  bool in_spec;			/* TRUE if further specification statements
-				   may follow, FALSE if executable stmts. */
-  bool in_func;			/* TRUE if ENTRY is a FUNCTION, not
-				   SUBROUTINE. */
-
-  assert ((entryname != NULL)
-	  && (ffelex_token_type (entryname) == FFELEX_typeNAME));
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_entry_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_useless_ ();
-
-  switch (ffestw_state (ffestw_stack_top ()))
-    {
-    case FFESTV_stateFUNCTION1:
-    case FFESTV_stateFUNCTION2:
-    case FFESTV_stateFUNCTION3:
-      in_func = TRUE;
-      in_spec = TRUE;
-      break;
-
-    case FFESTV_stateFUNCTION4:
-      in_func = TRUE;
-      in_spec = FALSE;
-      break;
-
-    case FFESTV_stateSUBROUTINE1:
-    case FFESTV_stateSUBROUTINE2:
-    case FFESTV_stateSUBROUTINE3:
-      in_func = FALSE;
-      in_spec = TRUE;
-      break;
-
-    case FFESTV_stateSUBROUTINE4:
-      in_func = FALSE;
-      in_spec = FALSE;
-      break;
-
-    default:
-      assert ("ENTRY not in FUNCTION or SUBROUTINE?" == NULL);
-      in_func = FALSE;
-      in_spec = FALSE;
-      break;
-    }
-
-  if (in_func)
-    fs = ffesymbol_declare_funcunit (entryname);
-  else
-    fs = ffesymbol_declare_subrunit (entryname);
-
-  if (ffesymbol_state (fs) == FFESYMBOL_stateNONE)
-    ffesymbol_set_state (fs, FFESYMBOL_stateUNDERSTOOD);
-  else
-    {
-      if (ffesymbol_kind (fs) != FFEINFO_kindANY)
-	ffesymbol_error (fs, entryname);
-    }
-
-  ++ffestc_entry_num_;
-
-  ffebld_init_list (&fs->dummy_args, &ffestc_local_.dummy.list_bottom);
-  if (in_spec)
-    ffestt_tokenlist_drive (args, ffestc_promote_dummy_);
-  else
-    ffestt_tokenlist_drive (args, ffestc_promote_execdummy_);
-  ffebld_end_list (&ffestc_local_.dummy.list_bottom);
-
-  if (in_func)
-    {
-      s = ffesymbol_declare_funcresult (entryname);
-      ffesymbol_set_funcresult (fs, s);
-      ffesymbol_set_funcresult (s, fs);
-      sa = ffesymbol_attrs (s);
-
-      /* Figure out what kind of object we've got based on previous
-	 declarations of or references to the object. */
-
-      if (ffesymbol_state (s) == FFESYMBOL_stateUNDERSTOOD)
-	na = FFESYMBOL_attrsetNONE;
-      else if (sa & FFESYMBOL_attrsANY)
-	na = FFESYMBOL_attrsANY;
-      else if (!(sa & ~(FFESYMBOL_attrsANYLEN
-			| FFESYMBOL_attrsTYPE)))
-	na = sa | FFESYMBOL_attrsRESULT;
-      else
-	na = FFESYMBOL_attrsetNONE;
-
-      /* Now see what we've got for a new object: NONE means a new error
-	 cropped up; ANY means an old error to be ignored; otherwise,
-	 everything's ok, update the object (symbol) and continue on. */
-
-      if (na == FFESYMBOL_attrsetNONE)
-	{
-	  ffesymbol_error (s, entryname);
-	  ffestc_parent_ok_ = FALSE;
-	}
-      else if (na & FFESYMBOL_attrsANY)
-	{
-	  ffestc_parent_ok_ = FALSE;
-	}
-      else
-	{
-	  ffesymbol_set_attrs (s, na);
-	  if (ffesymbol_state (s) == FFESYMBOL_stateNONE)
-	    ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-	  else if (ffesymbol_state (s) == FFESYMBOL_stateUNCERTAIN)
-	    {
-	      ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	      ffesymbol_set_info (s,
-				  ffeinfo_new (ffesymbol_basictype (s),
-					       ffesymbol_kindtype (s),
-					       0,
-					       FFEINFO_kindENTITY,
-					       FFEINFO_whereRESULT,
-					       ffesymbol_size (s)));
-	      ffesymbol_resolve_intrin (s);
-	      ffestorag_exec_layout (s);
-	    }
-	}
-
-      /* Since ENTRY might appear after executable stmts, do what would have
-	 been done if it hadn't -- give symbol implicit type and
-	 exec-transition it.  */
-
-      if (!in_spec && ffesymbol_is_specable (s))
-	{
-	  if (!ffeimplic_establish_symbol (s))	/* Do implicit typing. */
-	    ffesymbol_error (s, entryname);
-	  s = ffecom_sym_exec_transition (s);
-	}
-
-      /* Use whatever type info is available for ENTRY to set up type for its
-	 global-name-space function symbol relative.  */
-
-      ffesymbol_set_info (fs,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       0,
-				       FFEINFO_kindFUNCTION,
-				       FFEINFO_whereLOCAL,
-				       ffesymbol_size (s)));
-
-
-      /* Check whether the type info fits the filewide expectations;
-	 set ok flag accordingly.  */
-
-      ffesymbol_reference (fs, entryname, FALSE);
-
-      /* ~~Question??:
-	 When ENTRY FOO() RESULT(IBAR) is supported, what will the typing be
-	 if FOO and IBAR would normally end up with different types?  I think
-	 the answer is that FOO is always given whatever type would be chosen
-	 for IBAR, rather than the other way around, and I think it ends up
-	 working that way for FUNCTION FOO() RESULT(IBAR), but this should be
-	 checked out in all its different combos. Related question is, is
-	 there any way that FOO in either case ends up without type info
-	 filled in?  Does anyone care?  */
-
-      ffesymbol_signal_unreported (s);
-    }
-  else
-    {
-      ffesymbol_set_info (fs,
-			  ffeinfo_new (FFEINFO_basictypeNONE,
-				       FFEINFO_kindtypeNONE,
-				       0,
-				       FFEINFO_kindSUBROUTINE,
-				       FFEINFO_whereLOCAL,
-				       FFETARGET_charactersizeNONE));
-    }
-
-  if (!in_spec)
-    fs = ffecom_sym_exec_transition (fs);
-
-  ffesymbol_signal_unreported (fs);
-
-  ffestd_R1226 (fs);
-}
-
-/* ffestc_R1227 -- RETURN statement
-
-   ffestc_R1227(expr,expr_token);
-
-   Make sure statement is valid here; implement.  expr and expr_token are
-   both NULL if there was no expression.  */
-
-void
-ffestc_R1227 (ffebld expr, ffelexToken expr_token)
-{
-  ffestw b;
-
-  ffestc_check_simple_ ();
-  if (ffestc_order_actionif_ () != FFESTC_orderOK_)
-    return;
-  ffestc_labeldef_notloop_begin_ ();
-
-  for (b = ffestw_stack_top (); ; b = ffestw_previous (b))
-    {
-      switch (ffestw_state (b))
-	{
-	case FFESTV_statePROGRAM4:
-	case FFESTV_stateSUBROUTINE4:
-	case FFESTV_stateFUNCTION4:
-	  goto base;		/* :::::::::::::::::::: */
-
-	case FFESTV_stateNIL:
-	  assert ("bad state" == NULL);
-	  break;
-
-	default:
-	  break;
-	}
-    }
-
- base:
-  switch (ffestw_state (b))
-    {
-    case FFESTV_statePROGRAM4:
-      if (ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_RETURN_IN_MAIN);
-	  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		       ffelex_token_where_column (ffesta_tokens[0]));
-	  ffebad_finish ();
-	}
-      if (expr != NULL)
-	{
-	  ffebad_start (FFEBAD_ALTRETURN_IN_PROGRAM);
-	  ffebad_here (0, ffelex_token_where_line (expr_token),
-		       ffelex_token_where_column (expr_token));
-	  ffebad_finish ();
-	  expr = NULL;
-	}
-      break;
-
-    case FFESTV_stateSUBROUTINE4:
-      break;
-
-    case FFESTV_stateFUNCTION4:
-      if (expr != NULL)
-	{
-	  ffebad_start (FFEBAD_ALTRETURN_IN_FUNCTION);
-	  ffebad_here (0, ffelex_token_where_line (expr_token),
-		       ffelex_token_where_column (expr_token));
-	  ffebad_finish ();
-	  expr = NULL;
-	}
-      break;
-
-    default:
-      assert ("bad state #2" == NULL);
-      break;
-    }
-
-  ffestd_R1227 (expr);
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-
-  /* notloop's that are actionif's can be the target of a loop-end
-     statement if they're in the "then" part of a logical IF, as
-     in "DO 10", "10 IF (...) RETURN".  */
-
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_R1229_start -- STMTFUNCTION statement begin
-
-   ffestc_R1229_start(func_name,func_arg_list,close_paren);
-
-   Verify that STMTFUNCTION is valid here, establish func_arg_list in a new
-   "live" scope within the current scope, and expect the actual expression
-   (or NULL) in ffestc_R1229_finish.  The reason there are two ffestc
-   functions to handle this is so the scope can be established, allowing
-   ffeexpr to assign proper characteristics to references to the dummy
-   arguments.  */
-
-void
-ffestc_R1229_start (ffelexToken name, ffesttTokenList args,
-		    ffelexToken final UNUSED)
-{
-  ffesymbol s;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-
-  ffestc_check_start_ ();
-  if (ffestc_order_sfunc_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  assert (name != NULL);
-  assert (args != NULL);
-
-  s = ffesymbol_declare_local (name, FALSE);
-  sa = ffesymbol_attrs (s);
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (!ffesymbol_is_specable (s))
-    na = FFESYMBOL_attrsetNONE;	/* Can't dcl sym ref'd in sfuncdef. */
-  else if (sa & FFESYMBOL_attrsANY)
-    na = FFESYMBOL_attrsANY;
-  else if (!(sa & ~FFESYMBOL_attrsTYPE))
-    na = sa | FFESYMBOL_attrsSFUNC;
-  else
-    na = FFESYMBOL_attrsetNONE;
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    {
-      ffesymbol_error (s, name);
-      ffestc_parent_ok_ = FALSE;
-    }
-  else if (na & FFESYMBOL_attrsANY)
-    ffestc_parent_ok_ = FALSE;
-  else
-    {
-      ffesymbol_set_attrs (s, na);
-      ffesymbol_set_state (s, FFESYMBOL_stateSEEN);
-      if (!ffeimplic_establish_symbol (s)
-	  || ((ffesymbol_basictype (s) == FFEINFO_basictypeCHARACTER)
-	      && (ffesymbol_size (s) == FFETARGET_charactersizeNONE)))
-	{
-	  ffesymbol_error (s, ffesta_tokens[0]);
-	  ffestc_parent_ok_ = FALSE;
-	}
-      else
-	{
-	  /* Tell ffeexpr that sfunc def is in progress.  */
-	  ffesymbol_set_sfexpr (s, ffebld_new_any ());
-	  ffebld_set_info (ffesymbol_sfexpr (s), ffeinfo_new_any ());
-	  ffestc_parent_ok_ = TRUE;
-	}
-    }
-
-  ffe_init_4 ();
-
-  if (ffestc_parent_ok_)
-    {
-      ffebld_init_list (&s->dummy_args, &ffestc_local_.dummy.list_bottom);
-      ffestc_sfdummy_argno_ = 0;
-      ffestt_tokenlist_drive (args, ffestc_promote_sfdummy_);
-      ffebld_end_list (&ffestc_local_.dummy.list_bottom);
-    }
-
-  ffestc_local_.sfunc.symbol = s;
-
-  ffestd_R1229_start (name, args);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_R1229_finish -- STMTFUNCTION statement list complete
-
-   ffestc_R1229_finish(expr,expr_token);
-
-   If expr is NULL, an error occurred parsing the expansion expression, so
-   just cancel the effects of ffestc_R1229_start and pretend nothing
-   happened.  Otherwise, install the expression as the expansion for the
-   statement function named in _start_, then clean up.	*/
-
-void
-ffestc_R1229_finish (ffebld expr, ffelexToken expr_token)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  if (ffestc_parent_ok_ && (expr != NULL))
-    ffesymbol_set_sfexpr (ffestc_local_.sfunc.symbol,
-			  ffeexpr_convert_to_sym (expr,
-						  expr_token,
-						  ffestc_local_.sfunc.symbol,
-						  ffesta_tokens[0]));
-
-  ffestd_R1229_finish (ffestc_local_.sfunc.symbol);
-
-  ffesymbol_signal_unreported (ffestc_local_.sfunc.symbol);
-
-  ffe_terminate_4 ();
-}
-
-/* ffestc_S3P4 -- INCLUDE line
-
-   ffestc_S3P4(filename,filename_token);
-
-   Make sure INCLUDE not preceded by any semicolons or a label def; implement.	*/
-
-void
-ffestc_S3P4 (ffebld filename, ffelexToken filename_token UNUSED)
-{
-  ffestc_check_simple_ ();
-  ffestc_labeldef_invalid_ ();
-
-  ffestd_S3P4 (filename);
-}
-
-/* ffestc_V014_start -- VOLATILE statement list begin
-
-   ffestc_V014_start();
-
-   Verify that VOLATILE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_V014_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_progspec_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestd_V014_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_V014_item_object -- VOLATILE statement for object-name
-
-   ffestc_V014_item_object(name_token);
-
-   Make sure name_token identifies a valid object to be VOLATILEd.  */
-
-void
-ffestc_V014_item_object (ffelexToken name)
-{
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_V014_item_object (name);
-}
-
-/* ffestc_V014_item_cblock -- VOLATILE statement for common-block-name
-
-   ffestc_V014_item_cblock(name_token);
-
-   Make sure name_token identifies a valid common block to be VOLATILEd.  */
-
-void
-ffestc_V014_item_cblock (ffelexToken name)
-{
-  ffestc_check_item_ ();
-  assert (name != NULL);
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_V014_item_cblock (name);
-}
-
-/* ffestc_V014_finish -- VOLATILE statement list complete
-
-   ffestc_V014_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_V014_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_V014_finish ();
-}
-
-/* ffestc_V020_start -- TYPE statement list begin
-
-   ffestc_V020_start();
-
-   Verify that TYPE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestc_V020_start (void)
-{
-  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.type.type_spec[FFESTP_typeixFORMAT]))
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-
-  format = ffestc_subr_format_
-    (&ffestp_file.type.type_spec[FFESTP_typeixFORMAT]);
-  ffestc_namelist_ = (format == FFESTV_formatNAMELIST);
-
-  ffestd_V020_start (format);
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_V020_item -- TYPE statement i/o item
-
-   ffestc_V020_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestc_V020_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_V020_item (expr);
-}
-
-/* ffestc_V020_finish -- TYPE statement list complete
-
-   ffestc_V020_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_V020_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_V020_finish ();
-
-  if (ffestc_shriek_after1_ != NULL)
-    (*ffestc_shriek_after1_) (TRUE);
-  ffestc_labeldef_branch_end_ ();
-}
-
-/* ffestc_V027_start -- VXT PARAMETER statement list begin
-
-   ffestc_V027_start();
-
-   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/
-
-void
-ffestc_V027_start (void)
-{
-  ffestc_check_start_ ();
-  if (ffestc_order_parameter_ () != FFESTC_orderOK_)
-    {
-      ffestc_ok_ = FALSE;
-      return;
-    }
-  ffestc_labeldef_useless_ ();
-
-  ffestd_V027_start ();
-
-  ffestc_ok_ = TRUE;
-}
-
-/* ffestc_V027_item -- VXT PARAMETER statement assignment
-
-   ffestc_V027_item(dest,dest_token,source,source_token);
-
-   Make sure the source is a valid source for the destination; make the
-   assignment.	*/
-
-void
-ffestc_V027_item (ffelexToken dest_token, ffebld source,
-		  ffelexToken source_token UNUSED)
-{
-  ffestc_check_item_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_V027_item (dest_token, source);
-}
-
-/* ffestc_V027_finish -- VXT PARAMETER statement list complete
-
-   ffestc_V027_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestc_V027_finish (void)
-{
-  ffestc_check_finish_ ();
-  if (!ffestc_ok_)
-    return;
-
-  ffestd_V027_finish ();
-}
-
-/* Any executable statement.  Mainly make sure that one-shot things
-   like the statement for a logical IF are reset.  */
-
-void
-ffestc_any (void)
-{
-  ffestc_check_simple_ ();
-
-  ffestc_order_any_ ();
-
-  ffestc_labeldef_any_ ();
-
-  if (ffestc_shriek_after1_ == NULL)
-    return;
-
-  ffestd_any ();
-
-  (*ffestc_shriek_after1_) (TRUE);
-}
diff --git a/gcc/f/stc.h b/gcc/f/stc.h
deleted file mode 100644
index 37feba6..0000000
--- a/gcc/f/stc.h
+++ /dev/null
@@ -1,234 +0,0 @@
-/* stc.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stc.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STC_H
-#define GCC_F_STC_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bad.h"
-#include "bld.h"
-#include "expr.h"
-#include "lex.h"
-#include "stp.h"
-#include "str.h"
-#include "stt.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-extern ffeexprContext ffestc_iolist_context_;
-
-/* Declare functions with prototypes. */
-
-void ffestc_decl_start (ffestpType type, ffelexToken typet, ffebld kind,
-			ffelexToken kindt, ffebld len, ffelexToken lent);
-void ffestc_decl_attrib (ffestpAttrib attrib, ffelexToken attribt,
-			 ffestrOther intent_kw, ffesttDimList dims);
-void ffestc_decl_item (ffelexToken name, ffebld kind, ffelexToken kindt,
-		       ffesttDimList dims, ffebld len, ffelexToken lent,
-		       ffebld init, ffelexToken initt, bool clist);
-void ffestc_decl_itemstartvals (void);
-void ffestc_decl_itemvalue (ffebld repeat, ffelexToken repeat_token,
-			    ffebld value, ffelexToken value_token);
-void ffestc_decl_itemendvals (ffelexToken t);
-void ffestc_decl_finish (void);
-void ffestc_elsewhere (ffelexToken where_token);
-void ffestc_end (void);
-void ffestc_eof (void);
-bool ffestc_exec_transition (void);
-void ffestc_ffebad_here_doiter (ffebadIndex i, ffesymbol s);
-void ffestc_init_3 (void);
-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);
-#define ffestc_let ffestc_R737
-void ffestc_terminate_4 (void);
-void ffestc_R501_start (ffestpType type, ffelexToken typet, ffebld kind,
-			ffelexToken kindt, ffebld len, ffelexToken lent);
-void ffestc_R501_attrib (ffestpAttrib attrib, ffelexToken attribt,
-			 ffestrOther intent_kw, ffesttDimList dims);
-void ffestc_R501_item (ffelexToken name, ffebld kind, ffelexToken kindt,
-	      ffesttDimList dims, ffebld len, ffelexToken lent, ffebld init,
-		       ffelexToken initt, bool clist);
-void ffestc_R501_itemstartvals (void);
-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);
-void ffestc_R522 (void);
-void ffestc_R522start (void);
-void ffestc_R522item_object (ffelexToken name);
-void ffestc_R522item_cblock (ffelexToken name);
-void ffestc_R522finish (void);
-void ffestc_R524_start (bool virtual);
-void ffestc_R524_item (ffelexToken name, ffesttDimList dims);
-void ffestc_R524_finish (void);
-void ffestc_R528_start (void);
-void ffestc_R528_item_object (ffebld expr, ffelexToken expr_token);
-void ffestc_R528_item_startvals (void);
-void ffestc_R528_item_value (ffebld repeat, ffelexToken repeat_token,
-			     ffebld value, ffelexToken value_token);
-void ffestc_R528_item_endvals (ffelexToken t);
-void ffestc_R528_finish (void);
-void ffestc_R537_start (void);
-void ffestc_R537_item (ffebld dest, ffelexToken dest_token, ffebld source,
-		       ffelexToken source_token);
-void ffestc_R537_finish (void);
-void ffestc_R539 (void);
-void ffestc_R539start (void);
-void ffestc_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
-		      ffebld len, ffelexToken lent, ffesttImpList letters);
-void ffestc_R539finish (void);
-void ffestc_R542_start (void);
-void ffestc_R542_item_nlist (ffelexToken name);
-void ffestc_R542_item_nitem (ffelexToken name);
-void ffestc_R542_finish (void);
-void ffestc_R544_start (void);
-void ffestc_R544_item (ffesttExprList exprlist);
-void ffestc_R544_finish (void);
-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);
-void ffestc_R737 (ffebld dest, ffebld source, ffelexToken source_token);
-void ffestc_R803 (ffelexToken construct_name, ffebld expr,
-		  ffelexToken expr_token);
-void ffestc_R804 (ffebld expr, ffelexToken expr_token, ffelexToken name);
-void ffestc_R805 (ffelexToken name);
-void ffestc_R806 (ffelexToken name);
-void ffestc_R807 (ffebld expr, ffelexToken expr_token);
-void ffestc_R809 (ffelexToken construct_name, ffebld expr,
-		  ffelexToken expr_token);
-void ffestc_R810 (ffesttCaseList cases, ffelexToken name);
-void ffestc_R811 (ffelexToken name);
-void ffestc_R819A (ffelexToken construct_name, ffelexToken label, ffebld var,
-   ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
-		ffelexToken end_token, ffebld incr, ffelexToken incr_token);
-void ffestc_R819B (ffelexToken construct_name, ffelexToken label, ffebld expr,
-		   ffelexToken expr_token);
-void ffestc_R820A (ffelexToken construct_name, ffebld var,
-   ffelexToken var_token, ffebld start, ffelexToken start_token, ffebld end,
-		ffelexToken end_token, ffebld incr, ffelexToken incr_token);
-void ffestc_R820B (ffelexToken construct_name, ffebld expr,
-		   ffelexToken expr_token);
-void ffestc_R825 (ffelexToken name);
-void ffestc_R834 (ffelexToken name);
-void ffestc_R835 (ffelexToken name);
-void ffestc_R836 (ffelexToken label);
-void ffestc_R837 (ffesttTokenList label_toks, ffebld expr,
-		  ffelexToken expr_token);
-void ffestc_R838 (ffelexToken label, ffebld target, ffelexToken target_token);
-void ffestc_R839 (ffebld target, ffelexToken target_token,
-		  ffesttTokenList label_toks);
-void ffestc_R840 (ffebld expr, ffelexToken expr_token, ffelexToken neg,
-		  ffelexToken zero, ffelexToken pos);
-void ffestc_R841 (void);
-void ffestc_R842 (ffebld expr, ffelexToken expr_token);
-void ffestc_R843 (ffebld expr, ffelexToken expr_token);
-void ffestc_R904 (void);
-void ffestc_R907 (void);
-void ffestc_R909_start (bool only_format);
-void ffestc_R909_item (ffebld expr, ffelexToken expr_token);
-void ffestc_R909_finish (void);
-void ffestc_R910_start (void);
-void ffestc_R910_item (ffebld expr, ffelexToken expr_token);
-void ffestc_R910_finish (void);
-void ffestc_R911_start (void);
-void ffestc_R911_item (ffebld expr, ffelexToken expr_token);
-void ffestc_R911_finish (void);
-void ffestc_R919 (void);
-void ffestc_R920 (void);
-void ffestc_R921 (void);
-void ffestc_R923A (void);
-void ffestc_R923B_start (void);
-void ffestc_R923B_item (ffebld expr, ffelexToken expr_token);
-void ffestc_R923B_finish (void);
-void ffestc_R1001 (ffesttFormatList f);
-void ffestc_R1102 (ffelexToken name);
-void ffestc_R1103 (ffelexToken name);
-void ffestc_R1111 (ffelexToken name);
-void ffestc_R1112 (ffelexToken name);
-void ffestc_R1207_start (void);
-void ffestc_R1207_item (ffelexToken name);
-void ffestc_R1207_finish (void);
-void ffestc_R1208_start (void);
-void ffestc_R1208_item (ffelexToken name);
-void ffestc_R1208_finish (void);
-void ffestc_R1212 (ffebld expr, ffelexToken expr_token);
-void ffestc_R1219 (ffelexToken funcname, ffesttTokenList args,
-	 ffelexToken final, ffestpType type, ffebld kind, ffelexToken kindt,
-   ffebld len, ffelexToken lent, ffelexToken recursive, ffelexToken result);
-void ffestc_R1221 (ffelexToken name);
-void ffestc_R1223 (ffelexToken subrname, ffesttTokenList args,
-		   ffelexToken final, ffelexToken recursive);
-void ffestc_R1225 (ffelexToken name);
-void ffestc_R1226 (ffelexToken entryname, ffesttTokenList args,
-		   ffelexToken final);
-void ffestc_R1227 (ffebld expr, ffelexToken expr_token);
-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);
-void ffestc_V014_start (void);
-void ffestc_V014_item_object (ffelexToken name);
-void ffestc_V014_item_cblock (ffelexToken name);
-void ffestc_V014_finish (void);
-void ffestc_V020_start (void);
-void ffestc_V020_item (ffebld expr, ffelexToken expr_token);
-void ffestc_V020_finish (void);
-void ffestc_V027_start (void);
-void ffestc_V027_item (ffelexToken dest_token, ffebld source,
-		       ffelexToken source_token);
-void ffestc_V027_finish (void);
-void ffestc_any (void);
-
-/* Define macros. */
-
-#define ffestc_context_iolist() ffestc_iolist_context_
-#define ffestc_init_0()
-#define ffestc_init_1()
-#define ffestc_init_2()
-#define ffestc_terminate_0()
-#define ffestc_terminate_1()
-#define ffestc_terminate_2()
-#define ffestc_terminate_3()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STC_H */
diff --git a/gcc/f/std.c b/gcc/f/std.c
deleted file mode 100644
index 09f0419..0000000
--- a/gcc/f/std.c
+++ /dev/null
@@ -1,3623 +0,0 @@
-/* std.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 2000, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      st.c
-
-   Description:
-      Implements the various statements and such like.
-
-   Modifications:
-      21-Nov-91	 JCB  2.0
-	 Split out actual code generation to ffeste.
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "std.h"
-#include "bld.h"
-#include "com.h"
-#include "lab.h"
-#include "lex.h"
-#include "malloc.h"
-#include "sta.h"
-#include "ste.h"
-#include "stp.h"
-#include "str.h"
-#include "sts.h"
-#include "stt.h"
-#include "stv.h"
-#include "stw.h"
-#include "symbol.h"
-#include "target.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-#define FFESTD_COPY_EASY_ 1	/* 1 for only one _subr_copy_xyz_ fn. */
-
-#define FFESTD_IS_END_OPTIMIZED_ 1	/* 0=always gen STOP/RETURN before
-					   END. */
-
-typedef enum
-  {
-    FFESTD_stateletSIMPLE_,	/* Expecting simple/start. */
-    FFESTD_stateletATTRIB_,	/* Expecting attrib/item/itemstart. */
-    FFESTD_stateletITEM_,	/* Expecting item/itemstart/finish. */
-    FFESTD_stateletITEMVALS_,	/* Expecting itemvalue/itemendvals. */
-    FFESTD_
-  } ffestdStatelet_;
-
-typedef enum
-  {
-    FFESTD_stmtidENDDOLOOP_,
-    FFESTD_stmtidENDLOGIF_,
-    FFESTD_stmtidEXECLABEL_,
-    FFESTD_stmtidFORMATLABEL_,
-    FFESTD_stmtidR737A_,	/* let */
-    FFESTD_stmtidR803_,		/* IF-block */
-    FFESTD_stmtidR804_,		/* ELSE IF */
-    FFESTD_stmtidR805_,		/* ELSE */
-    FFESTD_stmtidR806_,		/* END IF */
-    FFESTD_stmtidR807_,		/* IF-logical */
-    FFESTD_stmtidR809_,		/* SELECT CASE */
-    FFESTD_stmtidR810_,		/* CASE */
-    FFESTD_stmtidR811_,		/* END SELECT */
-    FFESTD_stmtidR819A_,	/* DO-iterative */
-    FFESTD_stmtidR819B_,	/* DO WHILE */
-    FFESTD_stmtidR825_,		/* END DO */
-    FFESTD_stmtidR834_,		/* CYCLE */
-    FFESTD_stmtidR835_,		/* EXIT */
-    FFESTD_stmtidR836_,		/* GOTO */
-    FFESTD_stmtidR837_,		/* GOTO-computed */
-    FFESTD_stmtidR838_,		/* ASSIGN */
-    FFESTD_stmtidR839_,		/* GOTO-assigned */
-    FFESTD_stmtidR840_,		/* IF-arithmetic */
-    FFESTD_stmtidR841_,		/* CONTINUE */
-    FFESTD_stmtidR842_,		/* STOP */
-    FFESTD_stmtidR843_,		/* PAUSE */
-    FFESTD_stmtidR904_,		/* OPEN */
-    FFESTD_stmtidR907_,		/* CLOSE */
-    FFESTD_stmtidR909_,		/* READ */
-    FFESTD_stmtidR910_,		/* WRITE */
-    FFESTD_stmtidR911_,		/* PRINT */
-    FFESTD_stmtidR919_,		/* BACKSPACE */
-    FFESTD_stmtidR920_,		/* ENDFILE */
-    FFESTD_stmtidR921_,		/* REWIND */
-    FFESTD_stmtidR923A_,	/* INQUIRE */
-    FFESTD_stmtidR923B_,	/* INQUIRE-iolength */
-    FFESTD_stmtidR1001_,	/* FORMAT */
-    FFESTD_stmtidR1103_,	/* END_PROGRAM */
-    FFESTD_stmtidR1112_,	/* END_BLOCK_DATA */
-    FFESTD_stmtidR1212_,	/* CALL */
-    FFESTD_stmtidR1221_,	/* END_FUNCTION */
-    FFESTD_stmtidR1225_,	/* END_SUBROUTINE */
-    FFESTD_stmtidR1226_,	/* ENTRY */
-    FFESTD_stmtidR1227_,	/* RETURN */
-    FFESTD_stmtidV020_,		/* TYPE */
-    FFESTD_stmtid_,
-  } ffestdStmtId_;
-
-/* Internal typedefs. */
-
-typedef struct _ffestd_expr_item_ *ffestdExprItem_;
-typedef struct _ffestd_stmt_ *ffestdStmt_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffestd_expr_item_
-  {
-    ffestdExprItem_ next;
-    ffebld expr;
-    ffelexToken token;
-  };
-
-struct _ffestd_stmt_
-  {
-    ffestdStmt_ next;
-    ffestdStmt_ previous;
-    ffestdStmtId_ id;
-    char *filename;
-    int filelinenum;
-    union
-      {
-	struct
-	  {
-	    ffestw block;
-	  }
-	enddoloop;
-	struct
-	  {
-	    ffelab label;
-	  }
-	execlabel;
-	struct
-	  {
-	    ffelab label;
-	  }
-	formatlabel;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld dest;
-	    ffebld source;
-	  }
-	R737A;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    ffebld expr;
-	  }
-	R803;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    ffebld expr;
-	  }
-	R804;
-	struct
-	  {
-	    ffestw block;
-	  }
-	R805;
-	struct
-	  {
-	    ffestw block;
-	  }
-	R806;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld expr;
-	  }
-	R807;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    ffebld expr;
-	  }
-	R809;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    unsigned long casenum;
-	  }
-	R810;
-	struct
-	  {
-	    ffestw block;
-	  }
-	R811;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    ffelab label;
-	    ffebld var;
-	    ffebld start;
-	    ffelexToken start_token;
-	    ffebld end;
-	    ffelexToken end_token;
-	    ffebld incr;
-	    ffelexToken incr_token;
-	  }
-	R819A;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    ffelab label;
-	    ffebld expr;
-	  }
-	R819B;
-	struct
-	  {
-	    ffestw block;
-	  }
-	R834;
-	struct
-	  {
-	    ffestw block;
-	  }
-	R835;
-	struct
-	  {
-	    ffelab label;
-	  }
-	R836;
-	struct
-	  {
-	    mallocPool pool;
-	    ffelab *labels;
-	    int count;
-	    ffebld expr;
-	  }
-	R837;
-	struct
-	  {
-	    mallocPool pool;
-	    ffelab label;
-	    ffebld target;
-	  }
-	R838;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld target;
-	  }
-	R839;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld expr;
-	    ffelab neg;
-	    ffelab zero;
-	    ffelab pos;
-	  }
-	R840;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld expr;
-	  }
-	R842;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld expr;
-	  }
-	R843;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpOpenStmt *params;
-	  }
-	R904;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpCloseStmt *params;
-	  }
-	R907;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpReadStmt *params;
-	    bool only_format;
-	    ffestvUnit unit;
-	    ffestvFormat format;
-	    bool rec;
-	    bool key;
-	    ffestdExprItem_ list;
-	  }
-	R909;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpWriteStmt *params;
-	    ffestvUnit unit;
-	    ffestvFormat format;
-	    bool rec;
-	    ffestdExprItem_ list;
-	  }
-	R910;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpPrintStmt *params;
-	    ffestvFormat format;
-	    ffestdExprItem_ list;
-	  }
-	R911;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpBeruStmt *params;
-	  }
-	R919;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpBeruStmt *params;
-	  }
-	R920;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpBeruStmt *params;
-	  }
-	R921;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpInquireStmt *params;
-	    bool by_file;
-	  }
-	R923A;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpInquireStmt *params;
-	    ffestdExprItem_ list;
-	  }
-	R923B;
-	struct
-	  {
-	    ffestsHolder str;
-	  }
-	R1001;
-	struct
-	  {
-	    mallocPool pool;
-	    ffebld expr;
-	  }
-	R1212;
-	struct
-	  {
-	    ffesymbol entry;
-	    int entrynum;
-	  }
-	R1226;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestw block;
-	    ffebld expr;
-	  }
-	R1227;
-	struct
-	  {
-	    mallocPool pool;
-	    ffestpTypeStmt *params;
-	    ffestvFormat format;
-	    ffestdExprItem_ list;
-	  }
-	V020;
-      }
-    u;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-static ffestdStatelet_ ffestd_statelet_ = FFESTD_stateletSIMPLE_;
-static int ffestd_block_level_ = 0;	/* Block level for reachableness. */
-static bool ffestd_is_reachable_;	/* Is the current stmt reachable?  */
-static ffelab ffestd_label_formatdef_ = NULL;
-static ffestdExprItem_ *ffestd_expr_list_;
-static struct
-  {
-    ffestdStmt_ first;
-    ffestdStmt_ last;
-  }
-ffestd_stmt_list_ =
-{
-  NULL, NULL
-};
-
-
-/* # ENTRY statements pending. */
-static int ffestd_2pass_entrypoints_ = 0;
-
-/* Static functions (internal). */
-
-static void ffestd_stmt_append_ (ffestdStmt_ stmt);
-static ffestdStmt_ ffestd_stmt_new_ (ffestdStmtId_ id);
-static void ffestd_stmt_pass_ (void);
-#if FFESTD_COPY_EASY_
-static ffestpInquireStmt *ffestd_subr_copy_easy_ (ffestpInquireIx max);
-#endif
-static void ffestd_subr_vxt_ (void);
-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,
-				      const char *string);
-static void ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f,
-				      const char *string);
-static void ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f,
-				      const char *string);
-static void ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f,
-				      const char *string);
-static void ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f,
-				      const char *string);
-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_4_ (ffests s, ffesttFormatList f,
-				      const char *string);
-static void ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f,
-				      const char *string);
-static void ffestd_R1001error_ (ffesttFormatList f);
-static void ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr);
-
-/* Internal macros. */
-
-#define ffestd_subr_line_now_()					       \
-  ffeste_set_line (ffelex_token_where_filename (ffesta_tokens[0]), \
-		   ffelex_token_where_filelinenum (ffesta_tokens[0]))
-#define ffestd_subr_line_restore_(s) \
-  ffeste_set_line ((s)->filename, (s)->filelinenum)
-#define ffestd_subr_line_save_(s)					   \
-  ((s)->filename = ffelex_token_where_filename (ffesta_tokens[0]),	   \
-   (s)->filelinenum = ffelex_token_where_filelinenum (ffesta_tokens[0]))
-#define ffestd_check_simple_() \
-      assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_)
-#define ffestd_check_start_() \
-      assert(ffestd_statelet_ == FFESTD_stateletSIMPLE_); \
-      ffestd_statelet_ = FFESTD_stateletATTRIB_
-#define ffestd_check_attrib_() \
-      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_)
-#define ffestd_check_item_() \
-      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_	 \
-	    || ffestd_statelet_ == FFESTD_stateletITEM_); \
-      ffestd_statelet_ = FFESTD_stateletITEM_
-#define ffestd_check_item_startvals_() \
-      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_	 \
-	    || ffestd_statelet_ == FFESTD_stateletITEM_); \
-      ffestd_statelet_ = FFESTD_stateletITEMVALS_
-#define ffestd_check_item_value_() \
-      assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_)
-#define ffestd_check_item_endvals_() \
-      assert(ffestd_statelet_ == FFESTD_stateletITEMVALS_); \
-      ffestd_statelet_ = FFESTD_stateletITEM_
-#define ffestd_check_finish_() \
-      assert(ffestd_statelet_ == FFESTD_stateletATTRIB_	 \
-	    || ffestd_statelet_ == FFESTD_stateletITEM_); \
-      ffestd_statelet_ = FFESTD_stateletSIMPLE_
-
-#if FFESTD_COPY_EASY_
-#define ffestd_subr_copy_accept_() (ffestpAcceptStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_acceptix)
-#define ffestd_subr_copy_beru_() (ffestpBeruStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_beruix)
-#define ffestd_subr_copy_close_() (ffestpCloseStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_closeix)
-#define ffestd_subr_copy_delete_() (ffestpDeleteStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_deleteix)
-#define ffestd_subr_copy_find_() (ffestpFindStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_findix)
-#define ffestd_subr_copy_inquire_() (ffestpInquireStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_inquireix)
-#define ffestd_subr_copy_open_() (ffestpOpenStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_openix)
-#define ffestd_subr_copy_print_() (ffestpPrintStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_printix)
-#define ffestd_subr_copy_read_() (ffestpReadStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_readix)
-#define ffestd_subr_copy_rewrite_() (ffestpRewriteStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_rewriteix)
-#define ffestd_subr_copy_type_() (ffestpTypeStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_typeix)
-#define ffestd_subr_copy_vxtcode_() (ffestpVxtcodeStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_vxtcodeix)
-#define ffestd_subr_copy_write_() (ffestpWriteStmt *) \
-      ffestd_subr_copy_easy_((ffestpInquireIx) FFESTP_writeix)
-#endif
-
-/* ffestd_stmt_append_ -- Append statement to end of stmt list
-
-   ffestd_stmt_append_(ffestd_stmt_new_(FFESTD_stmtidR737A_));	*/
-
-static void
-ffestd_stmt_append_ (ffestdStmt_ stmt)
-{
-  stmt->next = (ffestdStmt_) &ffestd_stmt_list_.first;
-  stmt->previous = ffestd_stmt_list_.last;
-  stmt->next->previous = stmt;
-  stmt->previous->next = stmt;
-}
-
-/* ffestd_stmt_new_ -- Make new statement with given id
-
-   ffestdStmt_ stmt;
-   stmt = ffestd_stmt_new_(FFESTD_stmtidR737A_);  */
-
-static ffestdStmt_
-ffestd_stmt_new_ (ffestdStmtId_ id)
-{
-  ffestdStmt_ stmt;
-
-  stmt = malloc_new_kp (ffe_pool_any_unit (), "ffestdStmt_", sizeof (*stmt));
-  stmt->id = id;
-  return stmt;
-}
-
-/* ffestd_stmt_pass_ -- Pass all statements on list to ffeste
-
-   ffestd_stmt_pass_();	 */
-
-static void
-ffestd_stmt_pass_ (void)
-{
-  ffestdStmt_ stmt;
-  ffestdExprItem_ expr;		/* For traversing lists. */
-  bool okay = (TREE_CODE (current_function_decl) != ERROR_MARK);
-
-  if ((ffestd_2pass_entrypoints_ != 0) && okay)
-    {
-      tree which = ffecom_which_entrypoint_decl ();
-      tree value;
-      tree label;
-      int pushok;
-      int ents = ffestd_2pass_entrypoints_;
-      tree duplicate;
-
-      expand_start_case (0, which, TREE_TYPE (which), "entrypoint dispatch");
-
-      stmt = ffestd_stmt_list_.first;
-      do
-	{
-	  while (stmt->id != FFESTD_stmtidR1226_)
-	    stmt = stmt->next;
-
-	  if (stmt->u.R1226.entry != NULL)
-	    {
-	      value = build_int_2 (stmt->u.R1226.entrynum, 0);
-	      /* Yes, we really want to build a null LABEL_DECL here and not
-		 put it on any list.  That's what pushcase wants, so that's
-		 what it gets!  */
-	      label = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
-
-	      pushok = pushcase (value, convert, label, &duplicate);
-	      assert (pushok == 0);
-
-	      label = ffecom_temp_label ();
-	      TREE_USED (label) = 1;
-	      expand_goto (label);
-
-	      ffesymbol_hook (stmt->u.R1226.entry).length_tree = label;
-	    }
-	  stmt = stmt->next;
-	}
-      while (--ents != 0);
-
-      expand_end_case (which);
-    }
-
-  for (stmt = ffestd_stmt_list_.first;
-       stmt != (ffestdStmt_) &ffestd_stmt_list_.first;
-       stmt = stmt->next)
-    {
-      switch (stmt->id)
-	{
-	case FFESTD_stmtidENDDOLOOP_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_do (stmt->u.enddoloop.block);
-	  ffestw_kill (stmt->u.enddoloop.block);
-	  break;
-
-	case FFESTD_stmtidENDLOGIF_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_end_R807 ();
-	  break;
-
-	case FFESTD_stmtidEXECLABEL_:
-	  if (okay)
-	    ffeste_labeldef_branch (stmt->u.execlabel.label);
-	  break;
-
-	case FFESTD_stmtidFORMATLABEL_:
-	  if (okay)
-	    ffeste_labeldef_format (stmt->u.formatlabel.label);
-	  break;
-
-	case FFESTD_stmtidR737A_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R737A (stmt->u.R737A.dest, stmt->u.R737A.source);
-	  malloc_pool_kill (stmt->u.R737A.pool);
-	  break;
-
-	case FFESTD_stmtidR803_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R803 (stmt->u.R803.block, stmt->u.R803.expr);
-	  malloc_pool_kill (stmt->u.R803.pool);
-	  break;
-
-	case FFESTD_stmtidR804_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R804 (stmt->u.R803.block, stmt->u.R804.expr);
-	  malloc_pool_kill (stmt->u.R804.pool);
-	  break;
-
-	case FFESTD_stmtidR805_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R805 (stmt->u.R803.block);
-	  break;
-
-	case FFESTD_stmtidR806_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R806 (stmt->u.R806.block);
-	  ffestw_kill (stmt->u.R806.block);
-	  break;
-
-	case FFESTD_stmtidR807_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R807 (stmt->u.R807.expr);
-	  malloc_pool_kill (stmt->u.R807.pool);
-	  break;
-
-	case FFESTD_stmtidR809_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R809 (stmt->u.R809.block, stmt->u.R809.expr);
-	  malloc_pool_kill (stmt->u.R809.pool);
-	  break;
-
-	case FFESTD_stmtidR810_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R810 (stmt->u.R810.block, stmt->u.R810.casenum);
-	  malloc_pool_kill (stmt->u.R810.pool);
-	  break;
-
-	case FFESTD_stmtidR811_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R811 (stmt->u.R811.block);
-	  malloc_pool_kill (ffestw_select (stmt->u.R811.block)->pool);
-	  ffestw_kill (stmt->u.R811.block);
-	  break;
-
-	case FFESTD_stmtidR819A_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R819A (stmt->u.R819A.block, stmt->u.R819A.label,
-			  stmt->u.R819A.var,
-			  stmt->u.R819A.start, stmt->u.R819A.start_token,
-			  stmt->u.R819A.end, stmt->u.R819A.end_token,
-			  stmt->u.R819A.incr, stmt->u.R819A.incr_token);
-	  ffelex_token_kill (stmt->u.R819A.start_token);
-	  ffelex_token_kill (stmt->u.R819A.end_token);
-	  if (stmt->u.R819A.incr_token != NULL)
-	    ffelex_token_kill (stmt->u.R819A.incr_token);
-	  malloc_pool_kill (stmt->u.R819A.pool);
-	  break;
-
-	case FFESTD_stmtidR819B_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R819B (stmt->u.R819B.block, stmt->u.R819B.label,
-			  stmt->u.R819B.expr);
-	  malloc_pool_kill (stmt->u.R819B.pool);
-	  break;
-
-	case FFESTD_stmtidR825_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R825 ();
-	  break;
-
-	case FFESTD_stmtidR834_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R834 (stmt->u.R834.block);
-	  break;
-
-	case FFESTD_stmtidR835_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R835 (stmt->u.R835.block);
-	  break;
-
-	case FFESTD_stmtidR836_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R836 (stmt->u.R836.label);
-	  break;
-
-	case FFESTD_stmtidR837_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R837 (stmt->u.R837.labels, stmt->u.R837.count,
-			 stmt->u.R837.expr);
-	  malloc_pool_kill (stmt->u.R837.pool);
-	  break;
-
-	case FFESTD_stmtidR838_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R838 (stmt->u.R838.label, stmt->u.R838.target);
-	  malloc_pool_kill (stmt->u.R838.pool);
-	  break;
-
-	case FFESTD_stmtidR839_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R839 (stmt->u.R839.target);
-	  malloc_pool_kill (stmt->u.R839.pool);
-	  break;
-
-	case FFESTD_stmtidR840_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R840 (stmt->u.R840.expr, stmt->u.R840.neg, stmt->u.R840.zero,
-			 stmt->u.R840.pos);
-	  malloc_pool_kill (stmt->u.R840.pool);
-	  break;
-
-	case FFESTD_stmtidR841_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R841 ();
-	  break;
-
-	case FFESTD_stmtidR842_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R842 (stmt->u.R842.expr);
-	  if (stmt->u.R842.pool != NULL)
-	    malloc_pool_kill (stmt->u.R842.pool);
-	  break;
-
-	case FFESTD_stmtidR843_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R843 (stmt->u.R843.expr);
-	  malloc_pool_kill (stmt->u.R843.pool);
-	  break;
-
-	case FFESTD_stmtidR904_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R904 (stmt->u.R904.params);
-	  malloc_pool_kill (stmt->u.R904.pool);
-	  break;
-
-	case FFESTD_stmtidR907_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R907 (stmt->u.R907.params);
-	  malloc_pool_kill (stmt->u.R907.pool);
-	  break;
-
-	case FFESTD_stmtidR909_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R909_start (stmt->u.R909.params, stmt->u.R909.only_format,
-			       stmt->u.R909.unit, stmt->u.R909.format,
-			       stmt->u.R909.rec, stmt->u.R909.key);
-	  for (expr = stmt->u.R909.list; expr != NULL; expr = expr->next)
-	    {
-	      if (okay)
-		ffeste_R909_item (expr->expr, expr->token);
-	      ffelex_token_kill (expr->token);
-	    }
-	  if (okay)
-	    ffeste_R909_finish ();
-	  malloc_pool_kill (stmt->u.R909.pool);
-	  break;
-
-	case FFESTD_stmtidR910_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R910_start (stmt->u.R910.params, stmt->u.R910.unit,
-			       stmt->u.R910.format, stmt->u.R910.rec);
-	  for (expr = stmt->u.R910.list; expr != NULL; expr = expr->next)
-	    {
-	      if (okay)
-		ffeste_R910_item (expr->expr, expr->token);
-	      ffelex_token_kill (expr->token);
-	    }
-	  if (okay)
-	    ffeste_R910_finish ();
-	  malloc_pool_kill (stmt->u.R910.pool);
-	  break;
-
-	case FFESTD_stmtidR911_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R911_start (stmt->u.R911.params, stmt->u.R911.format);
-	  for (expr = stmt->u.R911.list; expr != NULL; expr = expr->next)
-	    {
-	      if (okay)
-		ffeste_R911_item (expr->expr, expr->token);
-	      ffelex_token_kill (expr->token);
-	    }
-	  if (okay)
-	    ffeste_R911_finish ();
-	  malloc_pool_kill (stmt->u.R911.pool);
-	  break;
-
-	case FFESTD_stmtidR919_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R919 (stmt->u.R919.params);
-	  malloc_pool_kill (stmt->u.R919.pool);
-	  break;
-
-	case FFESTD_stmtidR920_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R920 (stmt->u.R920.params);
-	  malloc_pool_kill (stmt->u.R920.pool);
-	  break;
-
-	case FFESTD_stmtidR921_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R921 (stmt->u.R921.params);
-	  malloc_pool_kill (stmt->u.R921.pool);
-	  break;
-
-	case FFESTD_stmtidR923A_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R923A (stmt->u.R923A.params, stmt->u.R923A.by_file);
-	  malloc_pool_kill (stmt->u.R923A.pool);
-	  break;
-
-	case FFESTD_stmtidR923B_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R923B_start (stmt->u.R923B.params);
-	  for (expr = stmt->u.R923B.list; expr != NULL; expr = expr->next)
-	    {
-	      if (okay)
-		ffeste_R923B_item (expr->expr);
-	    }
-	  if (okay)
-	    ffeste_R923B_finish ();
-	  malloc_pool_kill (stmt->u.R923B.pool);
-	  break;
-
-	case FFESTD_stmtidR1001_:
-	  if (okay)
-	    ffeste_R1001 (&stmt->u.R1001.str);
-	  ffests_kill (&stmt->u.R1001.str);
-	  break;
-
-	case FFESTD_stmtidR1103_:
-	  if (okay)
-	    ffeste_R1103 ();
-	  break;
-
-	case FFESTD_stmtidR1112_:
-	  if (okay)
-	    ffeste_R1112 ();
-	  break;
-
-	case FFESTD_stmtidR1212_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R1212 (stmt->u.R1212.expr);
-	  malloc_pool_kill (stmt->u.R1212.pool);
-	  break;
-
-	case FFESTD_stmtidR1221_:
-	  if (okay)
-	    ffeste_R1221 ();
-	  break;
-
-	case FFESTD_stmtidR1225_:
-	  if (okay)
-	    ffeste_R1225 ();
-	  break;
-
-	case FFESTD_stmtidR1226_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (stmt->u.R1226.entry != NULL)
-	    {
-	      if (okay)
-		ffeste_R1226 (stmt->u.R1226.entry);
-	    }
-	  break;
-
-	case FFESTD_stmtidR1227_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_R1227 (stmt->u.R1227.block, stmt->u.R1227.expr);
-	  malloc_pool_kill (stmt->u.R1227.pool);
-	  break;
-
-	case FFESTD_stmtidV020_:
-	  ffestd_subr_line_restore_ (stmt);
-	  if (okay)
-	    ffeste_V020_start (stmt->u.V020.params, stmt->u.V020.format);
-	  for (expr = stmt->u.V020.list; expr != NULL; expr = expr->next)
-	    {
-	      if (okay)
-		ffeste_V020_item (expr->expr);
-	    }
-	  if (okay)
-	    ffeste_V020_finish ();
-	  malloc_pool_kill (stmt->u.V020.pool);
-	  break;
-
-	default:
-	  assert ("bad stmt->id" == NULL);
-	  break;
-	}
-    }
-}
-
-/* ffestd_subr_copy_easy_ -- Copy I/O statement data structure
-
-   ffestd_subr_copy_easy_();
-
-   Copies all data except tokens in the I/O data structure into a new
-   structure that lasts as long as the output pool for the current
-   statement.  Assumes that they are
-   overlaid with each other (union) in stp.h and the typing
-   and structure references assume (though not necessarily dangerous if
-   FALSE) that INQUIRE has the most file elements.  */
-
-#if FFESTD_COPY_EASY_
-static ffestpInquireStmt *
-ffestd_subr_copy_easy_ (ffestpInquireIx max)
-{
-  ffestpInquireStmt *stmt;
-  ffestpInquireIx ix;
-
-  stmt = malloc_new_kp (ffesta_output_pool, "FFESTD easy",
-			sizeof (ffestpFile) * max);
-
-  for (ix = 0; ix < max; ++ix)
-    {
-      if ((stmt->inquire_spec[ix].kw_or_val_present
-	   = ffestp_file.inquire.inquire_spec[ix].kw_or_val_present)
-	  && (stmt->inquire_spec[ix].value_present
-	      = ffestp_file.inquire.inquire_spec[ix].value_present))
-	{
-	  if ((stmt->inquire_spec[ix].value_is_label
-	       = ffestp_file.inquire.inquire_spec[ix].value_is_label))
-	    stmt->inquire_spec[ix].u.label
-	      = ffestp_file.inquire.inquire_spec[ix].u.label;
-	  else
-	    stmt->inquire_spec[ix].u.expr
-	      = ffestp_file.inquire.inquire_spec[ix].u.expr;
-	}
-    }
-
-  return stmt;
-}
-
-#endif
-/* ffestd_subr_labels_ -- Handle any undefined labels
-
-   ffestd_subr_labels_(FALSE);
-
-   For every undefined label, generate an error message and either define
-   label as a FORMAT() statement (for FORMAT labels) or as a STOP statement
-   (for all other labels).  */
-
-static void
-ffestd_subr_labels_ (bool unexpected)
-{
-  ffelab l;
-  ffelabHandle h;
-  ffelabNumber undef;
-  ffesttFormatList f;
-
-  undef = ffelab_number () - ffestv_num_label_defines_;
-
-  for (h = ffelab_handle_first (); h != NULL; h = ffelab_handle_next (h))
-    {
-      l = ffelab_handle_target (h);
-      if (ffewhere_line_is_unknown (ffelab_definition_line (l)))
-	{			/* Undefined label. */
-	  assert (!unexpected);
-	  assert (undef > 0);
-	  undef--;
-	  ffebad_start (FFEBAD_UNDEF_LABEL);
-	  if (ffelab_type (l) == FFELAB_typeLOOPEND)
-	    ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
-	  else if (ffelab_type (l) != FFELAB_typeANY)
-	    ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
-	  else if (!ffewhere_line_is_unknown (ffelab_firstref_line (l)))
-	    ffebad_here (0, ffelab_firstref_line (l), ffelab_firstref_column (l));
-	  else if (!ffewhere_line_is_unknown (ffelab_doref_line (l)))
-	    ffebad_here (0, ffelab_doref_line (l), ffelab_doref_column (l));
-	  else
-	    ffebad_here (0, ffelab_definition_line (l), ffelab_definition_column (l));
-	  ffebad_finish ();
-
-	  switch (ffelab_type (l))
-	    {
-	    case FFELAB_typeFORMAT:
-	      ffelab_set_definition_line (l,
-			      ffewhere_line_use (ffelab_firstref_line (l)));
-	      ffelab_set_definition_column (l,
-			  ffewhere_column_use (ffelab_firstref_column (l)));
-	      ffestv_num_label_defines_++;
-	      f = ffestt_formatlist_create (NULL, NULL);
-	      ffestd_labeldef_format (l);
-	      ffestd_R1001 (f);
-	      ffestt_formatlist_kill (f);
-	      break;
-
-	    case FFELAB_typeASSIGNABLE:
-	      ffelab_set_definition_line (l,
-			      ffewhere_line_use (ffelab_firstref_line (l)));
-	      ffelab_set_definition_column (l,
-			  ffewhere_column_use (ffelab_firstref_column (l)));
-	      ffestv_num_label_defines_++;
-	      ffelab_set_type (l, FFELAB_typeNOTLOOP);
-	      ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
-	      ffestd_labeldef_notloop (l);
-	      ffestd_R842 (NULL);
-	      break;
-
-	    case FFELAB_typeNOTLOOP:
-	      ffelab_set_definition_line (l,
-			      ffewhere_line_use (ffelab_firstref_line (l)));
-	      ffelab_set_definition_column (l,
-			  ffewhere_column_use (ffelab_firstref_column (l)));
-	      ffestv_num_label_defines_++;
-	      ffelab_set_blocknum (l, ffestw_blocknum (ffestw_stack_top ()));
-	      ffestd_labeldef_notloop (l);
-	      ffestd_R842 (NULL);
-	      break;
-
-	    default:
-	      assert ("bad label type" == NULL);
-	      /* Fall through. */
-	    case FFELAB_typeUNKNOWN:
-	    case FFELAB_typeANY:
-	      break;
-	    }
-	}
-    }
-  ffelab_handle_done (h);
-  assert (undef == 0);
-}
-
-/* ffestd_subr_vxt_ -- Report error about lack of full VXT support
-
-   ffestd_subr_vxt_();	*/
-
-static void
-ffestd_subr_vxt_ (void)
-{
-  ffebad_start (FFEBAD_VXT_UNSUPPORTED);
-  ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-	       ffelex_token_where_column (ffesta_tokens[0]));
-  ffebad_finish ();
-}
-
-/* ffestd_begin_uses -- Start a bunch of USE statements
-
-   ffestd_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).  */
-
-void
-ffestd_begin_uses (void)
-{
-}
-
-/* ffestd_do -- End of statement following DO-term-stmt etc
-
-   ffestd_do(TRUE);
-
-   Also invoked by _labeldef_branch_finish_ (or, in cases
-   of errors, other _labeldef_ functions) when the label definition is
-   for a DO-target (LOOPEND) label, once per matching/outstanding DO
-   block on the stack.	These cases invoke this function with ok==TRUE, so
-   only forced stack popping (via ffestd_eof_()) invokes it with ok==FALSE.  */
-
-void
-ffestd_do (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidENDDOLOOP_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.enddoloop.block = ffestw_stack_top ();
-
-  --ffestd_block_level_;
-  assert (ffestd_block_level_ >= 0);
-}
-
-/* ffestd_end_R807 -- End of statement following logical IF
-
-   ffestd_end_R807(TRUE);
-
-   Applies ONLY to logical IF, not to IF-THEN.	For example, does not
-   ffelex_token_kill the construct name for an IF-THEN block (the name
-   field is invalid for logical IF).  ok==TRUE iff statement following
-   logical IF (substatement) is valid; else, statement is invalid or
-   stack forcibly popped due to ffestd_eof_().	*/
-
-void
-ffestd_end_R807 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidENDLOGIF_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-
-  --ffestd_block_level_;
-  assert (ffestd_block_level_ >= 0);
-}
-
-/* ffestd_exec_begin -- Executable statements can start coming in now
-
-   ffestd_exec_begin();	 */
-
-void
-ffestd_exec_begin (void)
-{
-  ffecom_exec_transition ();
-
-  if (ffestd_2pass_entrypoints_ != 0)
-    {				/* Process pending ENTRY statements now that
-				   info filled in. */
-      ffestdStmt_ stmt;
-      int ents = ffestd_2pass_entrypoints_;
-
-      stmt = ffestd_stmt_list_.first;
-      do
-	{
-	  while (stmt->id != FFESTD_stmtidR1226_)
-	    stmt = stmt->next;
-
-	  if (!ffecom_2pass_advise_entrypoint (stmt->u.R1226.entry))
-	    {
-	      stmt->u.R1226.entry = NULL;
-	      --ffestd_2pass_entrypoints_;
-	    }
-	  stmt = stmt->next;
-	}
-      while (--ents != 0);
-    }
-}
-
-/* ffestd_exec_end -- Executable statements can no longer come in now
-
-   ffestd_exec_end();  */
-
-void
-ffestd_exec_end (void)
-{
-  location_t old_loc = input_location;
-
-  ffecom_end_transition ();
-
-  ffestd_stmt_pass_ ();
-
-  ffecom_finish_progunit ();
-
-  if (ffestd_2pass_entrypoints_ != 0)
-    {
-      int ents = ffestd_2pass_entrypoints_;
-      ffestdStmt_ stmt = ffestd_stmt_list_.first;
-
-      do
-	{
-	  while (stmt->id != FFESTD_stmtidR1226_)
-	    stmt = stmt->next;
-
-	  if (stmt->u.R1226.entry != NULL)
-	    {
-	      ffestd_subr_line_restore_ (stmt);
-	      ffecom_2pass_do_entrypoint (stmt->u.R1226.entry);
-	    }
-	  stmt = stmt->next;
-	}
-      while (--ents != 0);
-    }
-
-  ffestd_stmt_list_.first = NULL;
-  ffestd_stmt_list_.last = NULL;
-  ffestd_2pass_entrypoints_ = 0;
-
-  input_location = old_loc;
-}
-
-/* ffestd_init_3 -- Initialize for any program unit
-
-   ffestd_init_3();  */
-
-void
-ffestd_init_3 (void)
-{
-  ffestd_stmt_list_.first = (ffestdStmt_) &ffestd_stmt_list_.first;
-  ffestd_stmt_list_.last = (ffestdStmt_) &ffestd_stmt_list_.first;
-}
-
-/* Generate "code" for "any" label def.  */
-
-void
-ffestd_labeldef_any (ffelab label UNUSED)
-{
-}
-
-/* ffestd_labeldef_branch -- Generate "code" for branch label def
-
-   ffestd_labeldef_branch(label);  */
-
-void
-ffestd_labeldef_branch (ffelab label)
-{
-  ffestdStmt_ stmt;
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidEXECLABEL_);
-  ffestd_stmt_append_ (stmt);
-  stmt->u.execlabel.label = label;
-
-  ffestd_is_reachable_ = TRUE;
-}
-
-/* ffestd_labeldef_format -- Generate "code" for FORMAT label def
-
-   ffestd_labeldef_format(label);  */
-
-void
-ffestd_labeldef_format (ffelab label)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_label_formatdef_ = label;
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidFORMATLABEL_);
-  ffestd_stmt_append_ (stmt);
-  stmt->u.formatlabel.label = label;
-}
-
-/* ffestd_labeldef_useless -- Generate "code" for useless label def
-
-   ffestd_labeldef_useless(label);  */
-
-void
-ffestd_labeldef_useless (ffelab label UNUSED)
-{
-}
-
-/* ffestd_R522 -- SAVE statement with no list
-
-   ffestd_R522();
-
-   Verify that SAVE is valid here, and flag everything as SAVEd.  */
-
-void
-ffestd_R522 (void)
-{
-  ffestd_check_simple_ ();
-}
-
-/* ffestd_R522start -- SAVE statement list begin
-
-   ffestd_R522start();
-
-   Verify that SAVE is valid here, and begin accepting items in the list.  */
-
-void
-ffestd_R522start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R522item_object -- SAVE statement for object-name
-
-   ffestd_R522item_object(name_token);
-
-   Make sure name_token identifies a valid object to be SAVEd.	*/
-
-void
-ffestd_R522item_object (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R522item_cblock -- SAVE statement for common-block-name
-
-   ffestd_R522item_cblock(name_token);
-
-   Make sure name_token identifies a valid common block to be SAVEd.  */
-
-void
-ffestd_R522item_cblock (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R522finish -- SAVE statement list complete
-
-   ffestd_R522finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R522finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R524_start -- DIMENSION statement list begin
-
-   ffestd_R524_start(bool virtual);
-
-   Verify that DIMENSION is valid here, and begin accepting items in the list.	*/
-
-void
-ffestd_R524_start (bool virtual UNUSED)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R524_item -- DIMENSION statement for object-name
-
-   ffestd_R524_item(name_token,dim_list);
-
-   Make sure name_token identifies a valid object to be DIMENSIONd.  */
-
-void
-ffestd_R524_item (ffelexToken name UNUSED, ffesttDimList dims UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R524_finish -- DIMENSION statement list complete
-
-   ffestd_R524_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R524_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R537_start -- PARAMETER statement list begin
-
-   ffestd_R537_start();
-
-   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/
-
-void
-ffestd_R537_start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R537_item -- PARAMETER statement assignment
-
-   ffestd_R537_item(dest,dest_token,source,source_token);
-
-   Make sure the source is a valid source for the destination; make the
-   assignment.	*/
-
-void
-ffestd_R537_item (ffebld dest UNUSED, ffebld source UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R537_finish -- PARAMETER statement list complete
-
-   ffestd_R537_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R537_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R539 -- IMPLICIT NONE statement
-
-   ffestd_R539();
-
-   Verify that the IMPLICIT NONE statement is ok here and implement.  */
-
-void
-ffestd_R539 (void)
-{
-  ffestd_check_simple_ ();
-}
-
-/* ffestd_R539start -- IMPLICIT statement
-
-   ffestd_R539start();
-
-   Verify that the IMPLICIT statement is ok here and implement.	 */
-
-void
-ffestd_R539start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R539item -- IMPLICIT statement specification (R540)
-
-   ffestd_R539item(...);
-
-   Verify that the type and letter list are all ok and implement.  */
-
-void
-ffestd_R539item (ffestpType type UNUSED, ffebld kind UNUSED,
-		 ffelexToken kindt UNUSED, ffebld len UNUSED,
-		 ffelexToken lent UNUSED, ffesttImpList letters UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R539finish -- IMPLICIT statement
-
-   ffestd_R539finish();
-
-   Finish up any local activities.  */
-
-void
-ffestd_R539finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R542_start -- NAMELIST statement list begin
-
-   ffestd_R542_start();
-
-   Verify that NAMELIST is valid here, and begin accepting items in the list.  */
-
-void
-ffestd_R542_start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R542_item_nlist -- NAMELIST statement for group-name
-
-   ffestd_R542_item_nlist(groupname_token);
-
-   Make sure name_token identifies a valid object to be NAMELISTd.  */
-
-void
-ffestd_R542_item_nlist (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R542_item_nitem -- NAMELIST statement for variable-name
-
-   ffestd_R542_item_nitem(name_token);
-
-   Make sure name_token identifies a valid object to be NAMELISTd.  */
-
-void
-ffestd_R542_item_nitem (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R542_finish -- NAMELIST statement list complete
-
-   ffestd_R542_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R542_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R547_start -- COMMON statement list begin
-
-   ffestd_R547_start();
-
-   Verify that COMMON is valid here, and begin accepting items in the list.  */
-
-void
-ffestd_R547_start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R547_item_object -- COMMON statement for object-name
-
-   ffestd_R547_item_object(name_token,dim_list);
-
-   Make sure name_token identifies a valid object to be COMMONd.  */
-
-void
-ffestd_R547_item_object (ffelexToken name UNUSED,
-			 ffesttDimList dims UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R547_item_cblock -- COMMON statement for common-block-name
-
-   ffestd_R547_item_cblock(name_token);
-
-   Make sure name_token identifies a valid common block to be COMMONd.	*/
-
-void
-ffestd_R547_item_cblock (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_R547_finish -- COMMON statement list complete
-
-   ffestd_R547_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R547_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R737A -- Assignment statement outside of WHERE
-
-   ffestd_R737A(dest_expr,source_expr);	 */
-
-void
-ffestd_R737A (ffebld dest, ffebld source)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR737A_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R737A.pool = ffesta_output_pool;
-  stmt->u.R737A.dest = dest;
-  stmt->u.R737A.source = source;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-
-/* Block IF (IF-THEN) statement.  */
-
-void
-ffestd_R803 (ffelexToken construct_name UNUSED, ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR803_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R803.pool = ffesta_output_pool;
-  stmt->u.R803.block = ffestw_use (ffestw_stack_top ());
-  stmt->u.R803.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  ++ffestd_block_level_;
-  assert (ffestd_block_level_ > 0);
-}
-
-/* ELSE IF statement.  */
-
-void
-ffestd_R804 (ffebld expr, ffelexToken name UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR804_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R804.pool = ffesta_output_pool;
-  stmt->u.R804.block = ffestw_use (ffestw_stack_top ());
-  stmt->u.R804.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ELSE statement.  */
-
-void
-ffestd_R805 (ffelexToken name UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR805_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R805.block = ffestw_use (ffestw_stack_top ());
-}
-
-/* END IF statement.  */
-
-void
-ffestd_R806 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR806_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R806.block = ffestw_use (ffestw_stack_top ());
-
-  --ffestd_block_level_;
-  assert (ffestd_block_level_ >= 0);
-}
-
-/* ffestd_R807 -- Logical IF statement
-
-   ffestd_R807(expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestd_R807 (ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR807_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R807.pool = ffesta_output_pool;
-  stmt->u.R807.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  ++ffestd_block_level_;
-  assert (ffestd_block_level_ > 0);
-}
-
-/* ffestd_R809 -- SELECT CASE statement
-
-   ffestd_R809(construct_name,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestd_R809 (ffelexToken construct_name UNUSED, ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR809_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R809.pool = ffesta_output_pool;
-  stmt->u.R809.block = ffestw_use (ffestw_stack_top ());
-  stmt->u.R809.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-  malloc_pool_use (ffestw_select (ffestw_stack_top ())->pool);
-
-  ++ffestd_block_level_;
-  assert (ffestd_block_level_ > 0);
-}
-
-/* ffestd_R810 -- CASE statement
-
-   ffestd_R810(case_value_range_list,name);
-
-   If casenum is 0, it's CASE DEFAULT.	Else it's the case ranges at
-   the start of the first_stmt list in the select object at the top of
-   the stack that match casenum.  */
-
-void
-ffestd_R810 (unsigned long casenum)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR810_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R810.pool = ffesta_output_pool;
-  stmt->u.R810.block = ffestw_stack_top ();
-  stmt->u.R810.casenum = casenum;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R811 -- End a SELECT
-
-   ffestd_R811(TRUE);  */
-
-void
-ffestd_R811 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR811_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R811.block = ffestw_stack_top ();
-
-  --ffestd_block_level_;
-  assert (ffestd_block_level_ >= 0);
-}
-
-/* ffestd_R819A -- Iterative DO statement
-
-   ffestd_R819A(construct_name,label_token,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestd_R819A (ffelexToken construct_name UNUSED, ffelab label,
-	      ffebld var, ffebld start, ffelexToken start_token,
-	      ffebld end, ffelexToken end_token,
-	      ffebld incr, ffelexToken incr_token)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR819A_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R819A.pool = ffesta_output_pool;
-  stmt->u.R819A.block = ffestw_use (ffestw_stack_top ());
-  stmt->u.R819A.label = label;
-  stmt->u.R819A.var = var;
-  stmt->u.R819A.start = start;
-  stmt->u.R819A.start_token = ffelex_token_use (start_token);
-  stmt->u.R819A.end = end;
-  stmt->u.R819A.end_token = ffelex_token_use (end_token);
-  stmt->u.R819A.incr = incr;
-  stmt->u.R819A.incr_token = (incr_token == NULL) ? NULL
-    : ffelex_token_use (incr_token);
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  ++ffestd_block_level_;
-  assert (ffestd_block_level_ > 0);
-}
-
-/* ffestd_R819B -- DO WHILE statement
-
-   ffestd_R819B(construct_name,label_token,expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestd_R819B (ffelexToken construct_name UNUSED, ffelab label,
-	      ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR819B_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R819B.pool = ffesta_output_pool;
-  stmt->u.R819B.block = ffestw_use (ffestw_stack_top ());
-  stmt->u.R819B.label = label;
-  stmt->u.R819B.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  ++ffestd_block_level_;
-  assert (ffestd_block_level_ > 0);
-}
-
-/* ffestd_R825 -- END DO statement
-
-   ffestd_R825(name_token);
-
-   Make sure ffestd_kind_ identifies a DO block.  If not
-   NULL, make sure name_token gives the correct name.  Do whatever
-   is specific to seeing END DO with a DO-target label definition on it,
-   where the END DO is really treated as a CONTINUE (i.e. generate th
-   same code you would for CONTINUE).  ffestd_do handles the actual
-   generation of end-loop code.	 */
-
-void
-ffestd_R825 (ffelexToken name UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR825_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-}
-
-/* ffestd_R834 -- CYCLE statement
-
-   ffestd_R834(name_token);
-
-   Handle a CYCLE within a loop.  */
-
-void
-ffestd_R834 (ffestw block)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR834_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R834.block = block;
-}
-
-/* ffestd_R835 -- EXIT statement
-
-   ffestd_R835(name_token);
-
-   Handle a EXIT within a loop.	 */
-
-void
-ffestd_R835 (ffestw block)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR835_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R835.block = block;
-}
-
-/* ffestd_R836 -- GOTO statement
-
-   ffestd_R836(label);
-
-   Make sure label_token identifies a valid label for a GOTO.  Update
-   that label's info to indicate it is the target of a GOTO.  */
-
-void
-ffestd_R836 (ffelab label)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR836_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R836.label = label;
-
-  if (ffestd_block_level_ == 0)
-    ffestd_is_reachable_ = FALSE;
-}
-
-/* ffestd_R837 -- Computed GOTO statement
-
-   ffestd_R837(labels,expr);
-
-   Make sure label_list identifies valid labels for a GOTO.  Update
-   each label's info to indicate it is the target of a GOTO.  */
-
-void
-ffestd_R837 (ffelab *labels, int count, ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR837_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R837.pool = ffesta_output_pool;
-  stmt->u.R837.labels = labels;
-  stmt->u.R837.count = count;
-  stmt->u.R837.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R838 -- ASSIGN statement
-
-   ffestd_R838(label_token,target_variable,target_token);
-
-   Make sure label_token identifies a valid label for an assignment.  Update
-   that label's info to indicate it is the source of an assignment.  Update
-   target_variable's info to indicate it is the target the assignment of that
-   label.  */
-
-void
-ffestd_R838 (ffelab label, ffebld target)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR838_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R838.pool = ffesta_output_pool;
-  stmt->u.R838.label = label;
-  stmt->u.R838.target = target;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R839 -- Assigned GOTO statement
-
-   ffestd_R839(target,labels);
-
-   Make sure label_list identifies valid labels for a GOTO.  Update
-   each label's info to indicate it is the target of a GOTO.  */
-
-void
-ffestd_R839 (ffebld target, ffelab *labels UNUSED, int count UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR839_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R839.pool = ffesta_output_pool;
-  stmt->u.R839.target = target;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  if (ffestd_block_level_ == 0)
-    ffestd_is_reachable_ = FALSE;
-}
-
-/* ffestd_R840 -- Arithmetic IF statement
-
-   ffestd_R840(expr,expr_token,neg,zero,pos);
-
-   Make sure the labels are valid; implement.  */
-
-void
-ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR840_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R840.pool = ffesta_output_pool;
-  stmt->u.R840.expr = expr;
-  stmt->u.R840.neg = neg;
-  stmt->u.R840.zero = zero;
-  stmt->u.R840.pos = pos;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  if (ffestd_block_level_ == 0)
-    ffestd_is_reachable_ = FALSE;
-}
-
-/* ffestd_R841 -- CONTINUE statement
-
-   ffestd_R841();  */
-
-void
-ffestd_R841 (bool in_where UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-}
-
-/* ffestd_R842 -- STOP statement
-
-   ffestd_R842(expr);  */
-
-void
-ffestd_R842 (ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR842_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  if (ffesta_outpooldisp () == FFESTA_pooldispPRESERVE)
-    {
-      /* This is a "spurious" (automatically-generated) STOP
-	 that follows a previous STOP or other statement.
-	 Make sure we don't have an expression in the pool,
-	 and then mark that the pool has already been killed.  */
-      assert (expr == NULL);
-      stmt->u.R842.pool = NULL;
-      stmt->u.R842.expr = NULL;
-    }
-  else
-    {
-      stmt->u.R842.pool = ffesta_output_pool;
-      stmt->u.R842.expr = expr;
-      ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-    }
-
-  if (ffestd_block_level_ == 0)
-    ffestd_is_reachable_ = FALSE;
-}
-
-/* ffestd_R843 -- PAUSE statement
-
-   ffestd_R843(expr,expr_token);
-
-   Make sure statement is valid here; implement.  expr and expr_token are
-   both NULL if there was no expression.  */
-
-void
-ffestd_R843 (ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR843_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R843.pool = ffesta_output_pool;
-  stmt->u.R843.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R904 -- OPEN statement
-
-   ffestd_R904();
-
-   Make sure an OPEN is valid in the current context, and implement it.	 */
-
-void
-ffestd_R904 (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-#define specified(something) \
-      (ffestp_file.open.open_spec[something].kw_or_val_present)
-
-  /* Warn if there are any thing we don't handle via f2c libraries. */
-
-  if (specified (FFESTP_openixACTION)
-      || specified (FFESTP_openixASSOCIATEVARIABLE)
-      || specified (FFESTP_openixBLOCKSIZE)
-      || specified (FFESTP_openixBUFFERCOUNT)
-      || specified (FFESTP_openixCARRIAGECONTROL)
-      || specified (FFESTP_openixDEFAULTFILE)
-      || specified (FFESTP_openixDELIM)
-      || specified (FFESTP_openixDISPOSE)
-      || specified (FFESTP_openixEXTENDSIZE)
-      || specified (FFESTP_openixINITIALSIZE)
-      || specified (FFESTP_openixKEY)
-      || specified (FFESTP_openixMAXREC)
-      || specified (FFESTP_openixNOSPANBLOCKS)
-      || specified (FFESTP_openixORGANIZATION)
-      || specified (FFESTP_openixPAD)
-      || specified (FFESTP_openixPOSITION)
-      || specified (FFESTP_openixREADONLY)
-      || specified (FFESTP_openixRECORDTYPE)
-      || specified (FFESTP_openixSHARED)
-      || specified (FFESTP_openixUSEROPEN))
-    {
-      ffebad_start (FFEBAD_OPEN_UNSUPPORTED);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-    }
-
-#undef specified
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR904_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R904.pool = ffesta_output_pool;
-  stmt->u.R904.params = ffestd_subr_copy_open_ ();
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R907 -- CLOSE statement
-
-   ffestd_R907();
-
-   Make sure a CLOSE is valid in the current context, and implement it.	 */
-
-void
-ffestd_R907 (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR907_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R907.pool = ffesta_output_pool;
-  stmt->u.R907.params = ffestd_subr_copy_close_ ();
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R909_start -- READ(...) statement list begin
-
-   ffestd_R909_start(FALSE);
-
-   Verify that READ is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestd_R909_start (bool only_format, ffestvUnit unit,
-		   ffestvFormat format, bool rec, bool key)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_start_ ();
-
-#define specified(something) \
-      (ffestp_file.read.read_spec[something].kw_or_val_present)
-
-  /* Warn if there are any thing we don't handle via f2c libraries. */
-  if (specified (FFESTP_readixADVANCE)
-      || specified (FFESTP_readixEOR)
-      || specified (FFESTP_readixKEYEQ)
-      || specified (FFESTP_readixKEYGE)
-      || specified (FFESTP_readixKEYGT)
-      || specified (FFESTP_readixKEYID)
-      || specified (FFESTP_readixNULLS)
-      || specified (FFESTP_readixSIZE))
-    {
-      ffebad_start (FFEBAD_READ_UNSUPPORTED);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-    }
-
-#undef specified
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR909_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R909.pool = ffesta_output_pool;
-  stmt->u.R909.params = ffestd_subr_copy_read_ ();
-  stmt->u.R909.only_format = only_format;
-  stmt->u.R909.unit = unit;
-  stmt->u.R909.format = format;
-  stmt->u.R909.rec = rec;
-  stmt->u.R909.key = key;
-  stmt->u.R909.list = NULL;
-  ffestd_expr_list_ = &stmt->u.R909.list;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R909_item -- READ statement i/o item
-
-   ffestd_R909_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestd_R909_item (ffebld expr, ffelexToken expr_token)
-{
-  ffestdExprItem_ item;
-
-  ffestd_check_item_ ();
-
-  item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item));
-
-  item->next = NULL;
-  item->expr = expr;
-  item->token = ffelex_token_use (expr_token);
-  *ffestd_expr_list_ = item;
-  ffestd_expr_list_ = &item->next;
-}
-
-/* ffestd_R909_finish -- READ statement list complete
-
-   ffestd_R909_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R909_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R910_start -- WRITE(...) statement list begin
-
-   ffestd_R910_start();
-
-   Verify that WRITE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_start_ ();
-
-#define specified(something) \
-      (ffestp_file.write.write_spec[something].kw_or_val_present)
-
-  /* Warn if there are any thing we don't handle via f2c libraries. */
-  if (specified (FFESTP_writeixADVANCE)
-      || specified (FFESTP_writeixEOR))
-    {
-      ffebad_start (FFEBAD_WRITE_UNSUPPORTED);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-    }
-
-#undef specified
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR910_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R910.pool = ffesta_output_pool;
-  stmt->u.R910.params = ffestd_subr_copy_write_ ();
-  stmt->u.R910.unit = unit;
-  stmt->u.R910.format = format;
-  stmt->u.R910.rec = rec;
-  stmt->u.R910.list = NULL;
-  ffestd_expr_list_ = &stmt->u.R910.list;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R910_item -- WRITE statement i/o item
-
-   ffestd_R910_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestd_R910_item (ffebld expr, ffelexToken expr_token)
-{
-  ffestdExprItem_ item;
-
-  ffestd_check_item_ ();
-
-  item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item));
-
-  item->next = NULL;
-  item->expr = expr;
-  item->token = ffelex_token_use (expr_token);
-  *ffestd_expr_list_ = item;
-  ffestd_expr_list_ = &item->next;
-}
-
-/* ffestd_R910_finish -- WRITE statement list complete
-
-   ffestd_R910_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R910_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R911_start -- PRINT statement list begin
-
-   ffestd_R911_start();
-
-   Verify that PRINT is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestd_R911_start (ffestvFormat format)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_start_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR911_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R911.pool = ffesta_output_pool;
-  stmt->u.R911.params = ffestd_subr_copy_print_ ();
-  stmt->u.R911.format = format;
-  stmt->u.R911.list = NULL;
-  ffestd_expr_list_ = &stmt->u.R911.list;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R911_item -- PRINT statement i/o item
-
-   ffestd_R911_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestd_R911_item (ffebld expr, ffelexToken expr_token)
-{
-  ffestdExprItem_ item;
-
-  ffestd_check_item_ ();
-
-  item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item));
-
-  item->next = NULL;
-  item->expr = expr;
-  item->token = ffelex_token_use (expr_token);
-  *ffestd_expr_list_ = item;
-  ffestd_expr_list_ = &item->next;
-}
-
-/* ffestd_R911_finish -- PRINT statement list complete
-
-   ffestd_R911_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R911_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R919 -- BACKSPACE statement
-
-   ffestd_R919();
-
-   Make sure a BACKSPACE is valid in the current context, and implement it.  */
-
-void
-ffestd_R919 (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR919_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R919.pool = ffesta_output_pool;
-  stmt->u.R919.params = ffestd_subr_copy_beru_ ();
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R920 -- ENDFILE statement
-
-   ffestd_R920();
-
-   Make sure a ENDFILE is valid in the current context, and implement it.  */
-
-void
-ffestd_R920 (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR920_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R920.pool = ffesta_output_pool;
-  stmt->u.R920.params = ffestd_subr_copy_beru_ ();
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R921 -- REWIND statement
-
-   ffestd_R921();
-
-   Make sure a REWIND is valid in the current context, and implement it.  */
-
-void
-ffestd_R921 (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR921_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R921.pool = ffesta_output_pool;
-  stmt->u.R921.params = ffestd_subr_copy_beru_ ();
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R923A -- INQUIRE statement (non-IOLENGTH version)
-
-   ffestd_R923A(bool by_file);
-
-   Make sure an INQUIRE is valid in the current context, and implement it.  */
-
-void
-ffestd_R923A (bool by_file)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-#define specified(something) \
-      (ffestp_file.inquire.inquire_spec[something].kw_or_val_present)
-
-  /* Warn if there are any thing we don't handle via f2c libraries. */
-  if (specified (FFESTP_inquireixACTION)
-      || specified (FFESTP_inquireixCARRIAGECONTROL)
-      || specified (FFESTP_inquireixDEFAULTFILE)
-      || specified (FFESTP_inquireixDELIM)
-      || specified (FFESTP_inquireixKEYED)
-      || specified (FFESTP_inquireixORGANIZATION)
-      || specified (FFESTP_inquireixPAD)
-      || specified (FFESTP_inquireixPOSITION)
-      || specified (FFESTP_inquireixREAD)
-      || specified (FFESTP_inquireixREADWRITE)
-      || specified (FFESTP_inquireixRECORDTYPE)
-      || specified (FFESTP_inquireixWRITE))
-    {
-      ffebad_start (FFEBAD_INQUIRE_UNSUPPORTED);
-      ffebad_here (0, ffelex_token_where_line (ffesta_tokens[0]),
-		   ffelex_token_where_column (ffesta_tokens[0]));
-      ffebad_finish ();
-    }
-
-#undef specified
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR923A_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R923A.pool = ffesta_output_pool;
-  stmt->u.R923A.params = ffestd_subr_copy_inquire_ ();
-  stmt->u.R923A.by_file = by_file;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R923B_start -- INQUIRE(IOLENGTH=expr) statement list begin
-
-   ffestd_R923B_start();
-
-   Verify that INQUIRE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestd_R923B_start (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_start_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR923B_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R923B.pool = ffesta_output_pool;
-  stmt->u.R923B.params = ffestd_subr_copy_inquire_ ();
-  stmt->u.R923B.list = NULL;
-  ffestd_expr_list_ = &stmt->u.R923B.list;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R923B_item -- INQUIRE statement i/o item
-
-   ffestd_R923B_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestd_R923B_item (ffebld expr)
-{
-  ffestdExprItem_ item;
-
-  ffestd_check_item_ ();
-
-  item = malloc_new_kp (ffesta_output_pool, "ffestdExprItem_", sizeof (*item));
-
-  item->next = NULL;
-  item->expr = expr;
-  *ffestd_expr_list_ = item;
-  ffestd_expr_list_ = &item->next;
-}
-
-/* ffestd_R923B_finish -- INQUIRE statement list complete
-
-   ffestd_R923B_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R923B_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R1001 -- FORMAT statement
-
-   ffestd_R1001(format_list);  */
-
-void
-ffestd_R1001 (ffesttFormatList f)
-{
-  ffestsHolder str;
-  ffests s = &str;
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  if (ffestd_label_formatdef_ == NULL)
-    return;			/* Nothing to hook it up to (no label def). */
-
-  ffests_new (s, malloc_pool_image (), 80);
-  ffests_putc (s, '(');
-  ffestd_R1001dump_ (s, f);	/* Build the string in s. */
-  ffests_putc (s, ')');
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1001_);
-  ffestd_stmt_append_ (stmt);
-  stmt->u.R1001.str = str;
-
-  ffestd_label_formatdef_ = NULL;
-}
-
-/* ffestd_R1001dump_ -- Dump list of formats
-
-   ffesttFormatList list;
-   ffestd_R1001dump_(list,0);
-
-   The formats in the list are dumped.	*/
-
-static void
-ffestd_R1001dump_ (ffests s, ffesttFormatList list)
-{
-  ffesttFormatList next;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      if (next != list->next)
-	ffests_putc (s, ',');
-      switch (next->type)
-	{
-	case FFESTP_formattypeI:
-	  ffestd_R1001dump_1005_3_ (s, next, "I");
-	  break;
-
-	case FFESTP_formattypeB:
-	  ffestd_R1001error_ (next);
-	  break;
-
-	case FFESTP_formattypeO:
-	  ffestd_R1001dump_1005_3_ (s, next, "O");
-	  break;
-
-	case FFESTP_formattypeZ:
-	  ffestd_R1001dump_1005_3_ (s, next, "Z");
-	  break;
-
-	case FFESTP_formattypeF:
-	  ffestd_R1001dump_1005_4_ (s, next, "F");
-	  break;
-
-	case FFESTP_formattypeE:
-	  ffestd_R1001dump_1005_5_ (s, next, "E");
-	  break;
-
-	case FFESTP_formattypeEN:
-	  ffestd_R1001error_ (next);
-	  break;
-
-	case FFESTP_formattypeG:
-	  ffestd_R1001dump_1005_5_ (s, next, "G");
-	  break;
-
-	case FFESTP_formattypeL:
-	  ffestd_R1001dump_1005_2_ (s, next, "L");
-	  break;
-
-	case FFESTP_formattypeA:
-	  ffestd_R1001dump_1005_1_ (s, next, "A");
-	  break;
-
-	case FFESTP_formattypeD:
-	  ffestd_R1001dump_1005_4_ (s, next, "D");
-	  break;
-
-	case FFESTP_formattypeQ:
-	  ffestd_R1001error_ (next);
-	  break;
-
-	case FFESTP_formattypeDOLLAR:
-	  ffestd_R1001dump_1010_1_ (s, next, "$");
-	  break;
-
-	case FFESTP_formattypeP:
-	  ffestd_R1001dump_1010_4_ (s, next, "P");
-	  break;
-
-	case FFESTP_formattypeT:
-	  ffestd_R1001dump_1010_5_ (s, next, "T");
-	  break;
-
-	case FFESTP_formattypeTL:
-	  ffestd_R1001dump_1010_5_ (s, next, "TL");
-	  break;
-
-	case FFESTP_formattypeTR:
-	  ffestd_R1001dump_1010_5_ (s, next, "TR");
-	  break;
-
-	case FFESTP_formattypeX:
-	  ffestd_R1001dump_1010_2_ (s, next, "X");
-	  break;
-
-	case FFESTP_formattypeS:
-	  ffestd_R1001dump_1010_1_ (s, next, "S");
-	  break;
-
-	case FFESTP_formattypeSP:
-	  ffestd_R1001dump_1010_1_ (s, next, "SP");
-	  break;
-
-	case FFESTP_formattypeSS:
-	  ffestd_R1001dump_1010_1_ (s, next, "SS");
-	  break;
-
-	case FFESTP_formattypeBN:
-	  ffestd_R1001dump_1010_1_ (s, next, "BN");
-	  break;
-
-	case FFESTP_formattypeBZ:
-	  ffestd_R1001dump_1010_1_ (s, next, "BZ");
-	  break;
-
-	case FFESTP_formattypeSLASH:
-	  ffestd_R1001dump_1010_2_ (s, next, "/");
-	  break;
-
-	case FFESTP_formattypeCOLON:
-	  ffestd_R1001dump_1010_1_ (s, next, ":");
-	  break;
-
-	case FFESTP_formattypeR1016:
-	  switch (ffelex_token_type (next->t))
-	    {
-	    case FFELEX_typeCHARACTER:
-	      {
-		char *p = ffelex_token_text (next->t);
-		ffeTokenLength i = ffelex_token_length (next->t);
-
-		ffests_putc (s, '\002');
-		while (i-- != 0)
-		  {
-		    if (*p == '\002')
-		      ffests_putc (s, '\002');
-		    ffests_putc (s, *p);
-		    ++p;
-		  }
-		ffests_putc (s, '\002');
-	      }
-	      break;
-
-	    case FFELEX_typeHOLLERITH:
-	      {
-		char *p = ffelex_token_text (next->t);
-		ffeTokenLength i = ffelex_token_length (next->t);
-
-		ffests_printf (s, "%" ffeTokenLength_f "uH", i);
-		while (i-- != 0)
-		  {
-		    ffests_putc (s, *p);
-		    ++p;
-		  }
-	      }
-	      break;
-
-	    default:
-	      assert (FALSE);
-	    }
-	  break;
-
-	case FFESTP_formattypeFORMAT:
-	  if (next->u.R1003D.R1004.present)
-	    {
-	      if (next->u.R1003D.R1004.rtexpr)
-		ffestd_R1001rtexpr_ (s, next, next->u.R1003D.R1004.u.expr);
-	      else
-		ffests_printf (s, "%lu", next->u.R1003D.R1004.u.unsigned_val);
-	    }
-
-	  ffests_putc (s, '(');
-	  ffestd_R1001dump_ (s, next->u.R1003D.format);
-	  ffests_putc (s, ')');
-	  break;
-
-	default:
-	  assert (FALSE);
-	}
-    }
-}
-
-/* ffestd_R1001dump_1005_1_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1005_1_(f,"I");
-
-   The format is dumped with form [r]X[w].  */
-
-static void
-ffestd_R1001dump_1005_1_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (!f->u.R1005.R1007_or_R1008.present);
-  assert (!f->u.R1005.R1009.present);
-
-  if (f->u.R1005.R1004.present)
-    {
-      if (f->u.R1005.R1004.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
-    }
-
-  ffests_puts (s, string);
-
-  if (f->u.R1005.R1006.present)
-    {
-      if (f->u.R1005.R1006.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
-    }
-}
-
-/* ffestd_R1001dump_1005_2_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1005_2_(f,"I");
-
-   The format is dumped with form [r]Xw.  */
-
-static void
-ffestd_R1001dump_1005_2_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (!f->u.R1005.R1007_or_R1008.present);
-  assert (!f->u.R1005.R1009.present);
-  assert (f->u.R1005.R1006.present);
-
-  if (f->u.R1005.R1004.present)
-    {
-      if (f->u.R1005.R1004.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
-    }
-
-  ffests_puts (s, string);
-
-  if (f->u.R1005.R1006.rtexpr)
-    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
-  else
-    ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
-}
-
-/* ffestd_R1001dump_1005_3_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1005_3_(f,"I");
-
-   The format is dumped with form [r]Xw[.m].  */
-
-static void
-ffestd_R1001dump_1005_3_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (!f->u.R1005.R1009.present);
-  assert (f->u.R1005.R1006.present);
-
-  if (f->u.R1005.R1004.present)
-    {
-      if (f->u.R1005.R1004.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
-    }
-
-  ffests_puts (s, string);
-
-  if (f->u.R1005.R1006.rtexpr)
-    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
-  else
-    ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
-
-  if (f->u.R1005.R1007_or_R1008.present)
-    {
-      ffests_putc (s, '.');
-      if (f->u.R1005.R1007_or_R1008.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
-    }
-}
-
-/* ffestd_R1001dump_1005_4_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1005_4_(f,"I");
-
-   The format is dumped with form [r]Xw.d.  */
-
-static void
-ffestd_R1001dump_1005_4_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (!f->u.R1005.R1009.present);
-  assert (f->u.R1005.R1007_or_R1008.present);
-  assert (f->u.R1005.R1006.present);
-
-  if (f->u.R1005.R1004.present)
-    {
-      if (f->u.R1005.R1004.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
-    }
-
-  ffests_puts (s, string);
-
-  if (f->u.R1005.R1006.rtexpr)
-    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
-  else
-    ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
-
-  ffests_putc (s, '.');
-  if (f->u.R1005.R1007_or_R1008.rtexpr)
-    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
-  else
-    ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
-}
-
-/* ffestd_R1001dump_1005_5_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1005_5_(f,"I");
-
-   The format is dumped with form [r]Xw.d[Ee].	*/
-
-static void
-ffestd_R1001dump_1005_5_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (f->u.R1005.R1007_or_R1008.present);
-  assert (f->u.R1005.R1006.present);
-
-  if (f->u.R1005.R1004.present)
-    {
-      if (f->u.R1005.R1004.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1004.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1004.u.unsigned_val);
-    }
-
-  ffests_puts (s, string);
-
-  if (f->u.R1005.R1006.rtexpr)
-    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1006.u.expr);
-  else
-    ffests_printf (s, "%lu", f->u.R1005.R1006.u.unsigned_val);
-
-  ffests_putc (s, '.');
-  if (f->u.R1005.R1007_or_R1008.rtexpr)
-    ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1007_or_R1008.u.expr);
-  else
-    ffests_printf (s, "%lu", f->u.R1005.R1007_or_R1008.u.unsigned_val);
-
-  if (f->u.R1005.R1009.present)
-    {
-      ffests_putc (s, 'E');
-      if (f->u.R1005.R1009.rtexpr)
-	ffestd_R1001rtexpr_ (s, f, f->u.R1005.R1009.u.expr);
-      else
-	ffests_printf (s, "%lu", f->u.R1005.R1009.u.unsigned_val);
-    }
-}
-
-/* ffestd_R1001dump_1010_1_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1010_1_(f,"I");
-
-   The format is dumped with form X.  */
-
-static void
-ffestd_R1001dump_1010_1_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (!f->u.R1010.val.present);
-
-  ffests_puts (s, string);
-}
-
-/* ffestd_R1001dump_1010_2_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1010_2_(f,"I");
-
-   The format is dumped with form [r]X.	 */
-
-static void
-ffestd_R1001dump_1010_2_ (ffests s, ffesttFormatList f, const char *string)
-{
-  if (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;
-   ffestd_R1001dump_1010_4_(f,"I");
-
-   The format is dumped with form kX.  Note that k is signed.  */
-
-static void
-ffestd_R1001dump_1010_4_ (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, "%ld", f->u.R1010.val.u.signed_val);
-
-  ffests_puts (s, string);
-}
-
-/* ffestd_R1001dump_1010_5_ -- Dump a particular format
-
-   ffesttFormatList f;
-   ffestd_R1001dump_1010_5_(f,"I");
-
-   The format is dumped with form Xn.  */
-
-static void
-ffestd_R1001dump_1010_5_ (ffests s, ffesttFormatList f, const char *string)
-{
-  assert (f->u.R1010.val.present);
-
-  ffests_puts (s, string);
-
-  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);
-}
-
-/* ffestd_R1001error_ -- Complain about FORMAT specification not supported
-
-   ffesttFormatList f;
-   ffestd_R1001error_(f);
-
-   An error message is produced.  */
-
-static void
-ffestd_R1001error_ (ffesttFormatList f)
-{
-  ffebad_start (FFEBAD_FORMAT_UNSUPPORTED);
-  ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
-  ffebad_finish ();
-}
-
-static void
-ffestd_R1001rtexpr_ (ffests s, ffesttFormatList f, ffebld expr)
-{
-  if ((expr == NULL)
-      || (ffebld_op (expr) != FFEBLD_opCONTER)
-      || (ffeinfo_basictype (ffebld_info (expr)) != FFEINFO_basictypeINTEGER)
-      || (ffeinfo_kindtype (ffebld_info (expr)) == FFEINFO_kindtypeINTEGER4))
-    {
-      ffebad_start (FFEBAD_FORMAT_VARIABLE);
-      ffebad_here (0, ffelex_token_where_line (f->t), ffelex_token_where_column (f->t));
-      ffebad_finish ();
-    }
-  else
-    {
-      int val;
-
-      switch (ffeinfo_kindtype (ffebld_info (expr)))
-	{
-#if FFETARGET_okINTEGER1
-	case FFEINFO_kindtypeINTEGER1:
-	  val = ffebld_constant_integer1 (ffebld_conter (expr));
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER2
-	case FFEINFO_kindtypeINTEGER2:
-	  val = ffebld_constant_integer2 (ffebld_conter (expr));
-	  break;
-#endif
-
-#if FFETARGET_okINTEGER3
-	case FFEINFO_kindtypeINTEGER3:
-	  val = ffebld_constant_integer3 (ffebld_conter (expr));
-	  break;
-#endif
-
-	default:
-	  assert ("bad INTEGER constant kind type" == NULL);
-	  /* Fall through. */
-	case FFEINFO_kindtypeANY:
-	  return;
-	}
-      ffests_printf (s, "%ld", (long) val);
-    }
-}
-
-/* ffestd_R1102 -- PROGRAM statement
-
-   ffestd_R1102(name_token);
-
-   Make sure ffestd_kind_ identifies an empty block.  Make sure name_token
-   gives a valid name.	Implement the beginning of a main program.  */
-
-void
-ffestd_R1102 (ffesymbol s, ffelexToken name UNUSED)
-{
-  ffestd_check_simple_ ();
-
-  assert (ffestd_block_level_ == 0);
-  ffestd_is_reachable_ = TRUE;
-
-  ffecom_notify_primary_entry (s);
-  ffe_set_is_mainprog (TRUE);	/* Is a main program. */
-  ffe_set_is_saveall (TRUE);	/* Main program always has implicit SAVE. */
-
-  ffestw_set_sym (ffestw_stack_top (), s);
-}
-
-/* ffestd_R1103 -- End a PROGRAM
-
-   ffestd_R1103();  */
-
-void
-ffestd_R1103 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  assert (ffestd_block_level_ == 0);
-
-  if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
-    ffestd_R842 (NULL);		/* Generate STOP. */
-
-  if (ffestw_state (ffestw_stack_top ()) != FFESTV_statePROGRAM5)
-    ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1103_);
-  ffestd_stmt_append_ (stmt);
-}
-
-/* ffestd_R1111 -- BLOCK DATA statement
-
-   ffestd_R1111(name_token);
-
-   Make sure ffestd_kind_ identifies no current program unit.  If not
-   NULL, make sure name_token gives a valid name.  Implement the beginning
-   of a block data program unit.  */
-
-void
-ffestd_R1111 (ffesymbol s, ffelexToken name UNUSED)
-{
-  assert (ffestd_block_level_ == 0);
-  ffestd_is_reachable_ = TRUE;
-
-  ffestd_check_simple_ ();
-
-  ffecom_notify_primary_entry (s);
-  ffestw_set_sym (ffestw_stack_top (), s);
-}
-
-/* ffestd_R1112 -- End a BLOCK DATA
-
-   ffestd_R1112(TRUE);	*/
-
-void
-ffestd_R1112 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  assert (ffestd_block_level_ == 0);
-
-  /* Generate any return-like code here (not likely for BLOCK DATA!). */
-
-  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateBLOCKDATA5)
-    ffestd_subr_labels_ (TRUE);	/* Handle any undefined labels. */
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1112_);
-  ffestd_stmt_append_ (stmt);
-}
-
-/* ffestd_R1207_start -- EXTERNAL statement list begin
-
-   ffestd_R1207_start();
-
-   Verify that EXTERNAL is valid here, and begin accepting items in the list.  */
-
-void
-ffestd_R1207_start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R1207_item -- EXTERNAL statement for name
-
-   ffestd_R1207_item(name_token);
-
-   Make sure name_token identifies a valid object to be EXTERNALd.  */
-
-void
-ffestd_R1207_item (ffelexToken name)
-{
-  ffestd_check_item_ ();
-  assert (name != NULL);
-}
-
-/* ffestd_R1207_finish -- EXTERNAL statement list complete
-
-   ffestd_R1207_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R1207_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R1208_start -- INTRINSIC statement list begin
-
-   ffestd_R1208_start();
-
-   Verify that INTRINSIC is valid here, and begin accepting items in the list.	*/
-
-void
-ffestd_R1208_start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R1208_item -- INTRINSIC statement for name
-
-   ffestd_R1208_item(name_token);
-
-   Make sure name_token identifies a valid object to be INTRINSICd.  */
-
-void
-ffestd_R1208_item (ffelexToken name)
-{
-  ffestd_check_item_ ();
-  assert (name != NULL);
-}
-
-/* ffestd_R1208_finish -- INTRINSIC statement list complete
-
-   ffestd_R1208_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_R1208_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_R1212 -- CALL statement
-
-   ffestd_R1212(expr,expr_token);
-
-   Make sure statement is valid here; implement.  */
-
-void
-ffestd_R1212 (ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1212_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R1212.pool = ffesta_output_pool;
-  stmt->u.R1212.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_R1219 -- FUNCTION statement
-
-   ffestd_R1219(funcname,arglist,ending_token,kind,kindt,len,lent,
-	 recursive);
-
-   Make sure statement is valid here, register arguments for the
-   function name, and so on.
-
-   06-Jun-90  JCB  2.0
-      Added the kind, len, and recursive arguments.  */
-
-void
-ffestd_R1219 (ffesymbol s, ffelexToken funcname UNUSED,
-	      ffesttTokenList args UNUSED, ffestpType type UNUSED,
-	      ffebld kind UNUSED, ffelexToken kindt UNUSED,
-	      ffebld len UNUSED, ffelexToken lent UNUSED,
-	      bool recursive UNUSED, ffelexToken result UNUSED,
-	      bool separate_result UNUSED)
-{
-  assert (ffestd_block_level_ == 0);
-  ffestd_is_reachable_ = TRUE;
-
-  ffestd_check_simple_ ();
-
-  ffecom_notify_primary_entry (s);
-  ffestw_set_sym (ffestw_stack_top (), s);
-}
-
-/* ffestd_R1221 -- End a FUNCTION
-
-   ffestd_R1221(TRUE);	*/
-
-void
-ffestd_R1221 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  assert (ffestd_block_level_ == 0);
-
-  if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
-    ffestd_R1227 (NULL);	/* Generate RETURN. */
-
-  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateFUNCTION5)
-    ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1221_);
-  ffestd_stmt_append_ (stmt);
-}
-
-/* ffestd_R1223 -- SUBROUTINE statement
-
-   ffestd_R1223(subrname,arglist,ending_token,recursive_token);
-
-   Make sure statement is valid here, register arguments for the
-   subroutine name, and so on.
-
-   06-Jun-90  JCB  2.0
-      Added the recursive argument.  */
-
-void
-ffestd_R1223 (ffesymbol s, ffelexToken subrname UNUSED,
-	      ffesttTokenList args UNUSED, ffelexToken final UNUSED,
-	      bool recursive UNUSED)
-{
-  assert (ffestd_block_level_ == 0);
-  ffestd_is_reachable_ = TRUE;
-
-  ffestd_check_simple_ ();
-
-  ffecom_notify_primary_entry (s);
-  ffestw_set_sym (ffestw_stack_top (), s);
-}
-
-/* ffestd_R1225 -- End a SUBROUTINE
-
-   ffestd_R1225(TRUE);	*/
-
-void
-ffestd_R1225 (bool ok UNUSED)
-{
-  ffestdStmt_ stmt;
-
-  assert (ffestd_block_level_ == 0);
-
-  if (FFESTD_IS_END_OPTIMIZED_ && ffestd_is_reachable_)
-    ffestd_R1227 (NULL);	/* Generate RETURN. */
-
-  if (ffestw_state (ffestw_stack_top ()) != FFESTV_stateSUBROUTINE5)
-    ffestd_subr_labels_ (FALSE);/* Handle any undefined labels. */
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1225_);
-  ffestd_stmt_append_ (stmt);
-}
-
-/* ffestd_R1226 -- ENTRY statement
-
-   ffestd_R1226(entryname,arglist,ending_token);
-
-   Make sure we're in a SUBROUTINE or FUNCTION, register arguments for the
-   entry point name, and so on.	 */
-
-void
-ffestd_R1226 (ffesymbol entry)
-{
-  ffestd_check_simple_ ();
-
-  if (!ffesta_seen_first_exec || ffecom_2pass_advise_entrypoint (entry))
-    {
-      ffestdStmt_ stmt;
-
-      stmt = ffestd_stmt_new_ (FFESTD_stmtidR1226_);
-      ffestd_stmt_append_ (stmt);
-      ffestd_subr_line_save_ (stmt);
-      stmt->u.R1226.entry = entry;
-      stmt->u.R1226.entrynum = ++ffestd_2pass_entrypoints_;
-    }
-
-  ffestd_is_reachable_ = TRUE;
-}
-
-/* ffestd_R1227 -- RETURN statement
-
-   ffestd_R1227(expr);
-
-   Make sure statement is valid here; implement.  expr and expr_token are
-   both NULL if there was no expression.  */
-
-void
-ffestd_R1227 (ffebld expr)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR1227_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-  stmt->u.R1227.pool = ffesta_output_pool;
-  stmt->u.R1227.block = ffestw_stack_top ();
-  stmt->u.R1227.expr = expr;
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-
-  if (ffestd_block_level_ == 0)
-    ffestd_is_reachable_ = FALSE;
-}
-
-/* ffestd_R1229_start -- STMTFUNCTION statement begin
-
-   ffestd_R1229_start(func_name,func_arg_list,close_paren);
-
-   This function does not really need to do anything, since _finish_
-   gets all the info needed, and ffestc_R1229_start has already
-   done all the stuff that makes a two-phase operation (start and
-   finish) for handling statement functions necessary.
-
-   03-Jan-91  JCB  2.0
-      Do nothing, now that _finish_ does everything.  */
-
-void
-ffestd_R1229_start (ffelexToken name UNUSED, ffesttTokenList args UNUSED)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_R1229_finish -- STMTFUNCTION statement list complete
-
-   ffestd_R1229_finish(s);
-
-   The statement function's symbol is passed.  Its list of dummy args is
-   accessed via ffesymbol_dummyargs and its expansion expression (expr)
-   is accessed via ffesymbol_sfexpr.
-
-   If sfexpr is NULL, an error occurred parsing the expansion expression, so
-   just cancel the effects of ffestd_R1229_start and pretend nothing
-   happened.  Otherwise, install the expression as the expansion for the
-   statement function, then clean up.
-
-   03-Jan-91  JCB  2.0
-      Takes sfunc sym instead of just the expansion expression as an
-      argument, so this function can do all the work, and _start_ is just
-      a nicety than can do nothing in a back end.  */
-
-void
-ffestd_R1229_finish (ffesymbol s)
-{
-  ffebld expr = ffesymbol_sfexpr (s);
-
-  ffestd_check_finish_ ();
-
-  if (expr == NULL)
-    return;			/* Nothing to do, definition didn't work. */
-
-  /* With gcc, cannot do anything here, because the backend hasn't even
-     (necessarily) been notified that we're compiling a program unit! */
-  ffesta_set_outpooldisp (FFESTA_pooldispPRESERVE);
-}
-
-/* ffestd_S3P4 -- INCLUDE line
-
-   ffestd_S3P4(filename,filename_token);
-
-   Make sure INCLUDE not preceded by any semicolons or a label def; implement.	*/
-
-void
-ffestd_S3P4 (ffebld filename)
-{
-  FILE *fi;
-  ffetargetCharacterDefault buildname;
-  ffewhereFile wf;
-
-  ffestd_check_simple_ ();
-
-  assert (filename != NULL);
-  if (ffebld_op (filename) != FFEBLD_opANY)
-    {
-      assert (ffebld_op (filename) == FFEBLD_opCONTER);
-      assert (ffeinfo_basictype (ffebld_info (filename))
-	      == FFEINFO_basictypeCHARACTER);
-      assert (ffeinfo_kindtype (ffebld_info (filename))
-	      == FFEINFO_kindtypeCHARACTERDEFAULT);
-      buildname = ffebld_constant_characterdefault (ffebld_conter (filename));
-      wf = ffewhere_file_new (ffetarget_text_characterdefault (buildname),
-			      ffetarget_length_characterdefault (buildname));
-      fi = ffecom_open_include (ffewhere_file_name (wf),
-				ffelex_token_where_line (ffesta_tokens[0]),
-				ffelex_token_where_column (ffesta_tokens[0]));
-      if (fi != NULL)
-	ffelex_set_include (wf, (ffelex_token_type (ffesta_tokens[0])
-				 == FFELEX_typeNAME), fi);
-    }
-}
-
-/* ffestd_V014_start -- VOLATILE statement list begin
-
-   ffestd_V014_start();
-
-   Verify that VOLATILE is valid here, and begin accepting items in the list.  */
-
-void
-ffestd_V014_start (void)
-{
-  ffestd_check_start_ ();
-}
-
-/* ffestd_V014_item_object -- VOLATILE statement for object-name
-
-   ffestd_V014_item_object(name_token);
-
-   Make sure name_token identifies a valid object to be VOLATILEd.  */
-
-void
-ffestd_V014_item_object (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_V014_item_cblock -- VOLATILE statement for common-block-name
-
-   ffestd_V014_item_cblock(name_token);
-
-   Make sure name_token identifies a valid common block to be VOLATILEd.  */
-
-void
-ffestd_V014_item_cblock (ffelexToken name UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_V014_finish -- VOLATILE statement list complete
-
-   ffestd_V014_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_V014_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_V020_start -- TYPE statement list begin
-
-   ffestd_V020_start();
-
-   Verify that TYPE is valid here, and begin accepting items in the
-   list.  */
-
-void
-ffestd_V020_start (ffestvFormat format UNUSED)
-{
-  ffestd_check_start_ ();
-  ffestd_subr_vxt_ ();
-}
-
-/* ffestd_V020_item -- TYPE statement i/o item
-
-   ffestd_V020_item(expr,expr_token);
-
-   Implement output-list expression.  */
-
-void
-ffestd_V020_item (ffebld expr UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_V020_finish -- TYPE statement list complete
-
-   ffestd_V020_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_V020_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* ffestd_V027_start -- VXT PARAMETER statement list begin
-
-   ffestd_V027_start();
-
-   Verify that PARAMETER is valid here, and begin accepting items in the list.	*/
-
-void
-ffestd_V027_start (void)
-{
-  ffestd_check_start_ ();
-  ffestd_subr_vxt_ ();
-}
-
-/* ffestd_V027_item -- VXT PARAMETER statement assignment
-
-   ffestd_V027_item(dest,dest_token,source,source_token);
-
-   Make sure the source is a valid source for the destination; make the
-   assignment.	*/
-
-void
-ffestd_V027_item (ffelexToken dest_token UNUSED, ffebld source UNUSED)
-{
-  ffestd_check_item_ ();
-}
-
-/* ffestd_V027_finish -- VXT PARAMETER statement list complete
-
-   ffestd_V027_finish();
-
-   Just wrap up any local activities.  */
-
-void
-ffestd_V027_finish (void)
-{
-  ffestd_check_finish_ ();
-}
-
-/* Any executable statement.  */
-
-void
-ffestd_any (void)
-{
-  ffestdStmt_ stmt;
-
-  ffestd_check_simple_ ();
-
-  stmt = ffestd_stmt_new_ (FFESTD_stmtidR841_);
-  ffestd_stmt_append_ (stmt);
-  ffestd_subr_line_save_ (stmt);
-}
diff --git a/gcc/f/std.h b/gcc/f/std.h
deleted file mode 100644
index 29a82a8..0000000
--- a/gcc/f/std.h
+++ /dev/null
@@ -1,194 +0,0 @@
-/* std.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      std.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STD_H
-#define GCC_F_STD_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "lab.h"
-#include "lex.h"
-#include "stp.h"
-#include "str.h"
-#include "stt.h"
-#include "stv.h"
-#include "stw.h"
-#include "symbol.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffestd_begin_uses (void);
-void ffestd_do (bool ok);
-void ffestd_end_R807 (bool ok);
-void ffestd_exec_begin (void);
-void ffestd_exec_end (void);
-void ffestd_init_3 (void);
-void ffestd_labeldef_any (ffelab label);
-void ffestd_labeldef_branch (ffelab label);
-void ffestd_labeldef_format (ffelab label);
-void ffestd_labeldef_useless (ffelab label);
-void ffestd_R522 (void);
-void ffestd_R522start (void);
-void ffestd_R522item_object (ffelexToken name);
-void ffestd_R522item_cblock (ffelexToken name);
-void ffestd_R522finish (void);
-void ffestd_R524_start (bool virtual);
-void ffestd_R524_item (ffelexToken name, ffesttDimList dims);
-void ffestd_R524_finish (void);
-void ffestd_R537_start (void);
-void ffestd_R537_item (ffebld dest, ffebld source);
-void ffestd_R537_finish (void);
-void ffestd_R539 (void);
-void ffestd_R539start (void);
-void ffestd_R539item (ffestpType type, ffebld kind, ffelexToken kindt,
-		      ffebld len, ffelexToken lent, ffesttImpList letters);
-void ffestd_R539finish (void);
-void ffestd_R542_start (void);
-void ffestd_R542_item_nlist (ffelexToken name);
-void ffestd_R542_item_nitem (ffelexToken name);
-void ffestd_R542_finish (void);
-void ffestd_R544_start (void);
-void ffestd_R544_item (ffesttExprList exprlist);
-void ffestd_R544_finish (void);
-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);
-void ffestd_R737A (ffebld dest, ffebld source);
-void ffestd_R803 (ffelexToken construct_name, ffebld expr);
-void ffestd_R804 (ffebld expr, ffelexToken name);
-void ffestd_R805 (ffelexToken name);
-void ffestd_R806 (bool ok);
-void ffestd_R807 (ffebld expr);
-void ffestd_R809 (ffelexToken construct_name, ffebld expr);
-void ffestd_R810 (unsigned long casenum);
-void ffestd_R811 (bool ok);
-void ffestd_R819A (ffelexToken construct_name, ffelab label, ffebld var,
-		   ffebld start, ffelexToken start_token,
-		   ffebld end, ffelexToken end_token,
-		   ffebld incr, ffelexToken incr_token);
-void ffestd_R819B (ffelexToken construct_name, ffelab label, ffebld expr);
-void ffestd_R825 (ffelexToken name);
-void ffestd_R834 (ffestw block);
-void ffestd_R835 (ffestw block);
-void ffestd_R836 (ffelab label);
-void ffestd_R837 (ffelab *labels, int count, ffebld expr);
-void ffestd_R838 (ffelab label, ffebld target);
-void ffestd_R839 (ffebld target, ffelab *labels, int count);
-void ffestd_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos);
-void ffestd_R841 (bool in_where);
-void ffestd_R842 (ffebld expr);
-void ffestd_R843 (ffebld expr);
-void ffestd_R904 (void);
-void ffestd_R907 (void);
-void ffestd_R909_start (bool only_format, ffestvUnit unit,
-			ffestvFormat format, bool rec, bool key);
-void ffestd_R909_item (ffebld expr, ffelexToken expr_token);
-void ffestd_R909_finish (void);
-void ffestd_R910_start (ffestvUnit unit, ffestvFormat format, bool rec);
-void ffestd_R910_item (ffebld expr, ffelexToken expr_token);
-void ffestd_R910_finish (void);
-void ffestd_R911_start (ffestvFormat format);
-void ffestd_R911_item (ffebld expr, ffelexToken expr_token);
-void ffestd_R911_finish (void);
-void ffestd_R919 (void);
-void ffestd_R920 (void);
-void ffestd_R921 (void);
-void ffestd_R923A (bool by_file);
-void ffestd_R923B_start (void);
-void ffestd_R923B_item (ffebld expr);
-void ffestd_R923B_finish (void);
-void ffestd_R1001 (ffesttFormatList f);
-void ffestd_R1102 (ffesymbol s, ffelexToken name);
-void ffestd_R1103 (bool ok);
-void ffestd_R1111 (ffesymbol s, ffelexToken name);
-void ffestd_R1112 (bool ok);
-void ffestd_R1207_start (void);
-void ffestd_R1207_item (ffelexToken name);
-void ffestd_R1207_finish (void);
-void ffestd_R1208_start (void);
-void ffestd_R1208_item (ffelexToken name);
-void ffestd_R1208_finish (void);
-void ffestd_R1212 (ffebld expr);
-void ffestd_R1219 (ffesymbol s, ffelexToken funcname,
-		   ffesttTokenList args, ffestpType type, ffebld kind,
-		   ffelexToken kindt, ffebld len, ffelexToken lent,
-		   bool recursive, ffelexToken result,
-		   bool separate_result);
-void ffestd_R1221 (bool ok);
-void ffestd_R1223 (ffesymbol s, ffelexToken subrname, ffesttTokenList args,
-		   ffelexToken final, bool recursive);
-void ffestd_R1225 (bool ok);
-void ffestd_R1226 (ffesymbol entry);
-void ffestd_R1227 (ffebld expr);
-void ffestd_R1229_start (ffelexToken name, ffesttTokenList args);
-void ffestd_R1229_finish (ffesymbol s);
-void ffestd_S3P4 (ffebld filename);
-void ffestd_V014_start (void);
-void ffestd_V014_item_object (ffelexToken name);
-void ffestd_V014_item_cblock (ffelexToken name);
-void ffestd_V014_finish (void);
-void ffestd_V020_start (ffestvFormat format);
-void ffestd_V020_item (ffebld expr);
-void ffestd_V020_finish (void);
-void ffestd_V027_start (void);
-void ffestd_V027_item (ffelexToken dest_token, ffebld source);
-void ffestd_V027_finish (void);
-void ffestd_any (void);
-
-/* Define macros. */
-
-#define ffestd_init_0()
-#define ffestd_init_1()
-#define ffestd_init_2()
-#define ffestd_init_4()
-#define ffestd_labeldef_notloop(l) ffestd_labeldef_branch(l)
-#define ffestd_labeldef_endif(l) ffestd_labeldef_branch(l)
-#define ffestd_terminate_0()
-#define ffestd_terminate_1()
-#define ffestd_terminate_2()
-#define ffestd_terminate_3()
-#define ffestd_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STD_H */
diff --git a/gcc/f/ste.c b/gcc/f/ste.c
deleted file mode 100644
index 82435bc..0000000
--- a/gcc/f/ste.c
+++ /dev/null
@@ -1,4475 +0,0 @@
-/* ste.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 2000, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      ste.c
-
-   Description:
-      Implements the various statements and such like.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "rtl.h"
-#include "toplev.h"
-#include "ggc.h"
-#include "ste.h"
-#include "bld.h"
-#include "com.h"
-#include "expr.h"
-#include "lab.h"
-#include "lex.h"
-#include "sta.h"
-#include "stp.h"
-#include "str.h"
-#include "sts.h"
-#include "stt.h"
-#include "stv.h"
-#include "stw.h"
-#include "symbol.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFESTE_stateletSIMPLE_,	/* Expecting simple/start. */
-    FFESTE_stateletATTRIB_,	/* Expecting attrib/item/itemstart. */
-    FFESTE_stateletITEM_,	/* Expecting item/itemstart/finish. */
-    FFESTE_stateletITEMVALS_,	/* Expecting itemvalue/itemendvals. */
-    FFESTE_
-  } ffesteStatelet_;
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-static ffesteStatelet_ ffeste_statelet_ = FFESTE_stateletSIMPLE_;
-static ffelab ffeste_label_formatdef_ = NULL;
-static tree (*ffeste_io_driver_) (ffebld expr);	/* do?io. */
-static ffecomGfrt ffeste_io_endgfrt_;	/* end function to call. */
-static tree ffeste_io_abort_;	/* abort-io label or NULL_TREE. */
-static bool ffeste_io_abort_is_temp_;	/* abort-io label is a temp. */
-static tree ffeste_io_end_;	/* END= label or NULL_TREE. */
-static tree ffeste_io_err_;	/* ERR= label or NULL_TREE. */
-static tree ffeste_io_iostat_;	/* IOSTAT= var or NULL_TREE. */
-static bool ffeste_io_iostat_is_temp_;	/* IOSTAT= var is a temp. */
-
-/* Static functions (internal). */
-
-static void ffeste_begin_iterdo_ (ffestw block, tree *tvar, tree *tincr,
-				  tree *xitersvar, ffebld var,
-				  ffebld start, ffelexToken start_token,
-				  ffebld end, ffelexToken end_token,
-				  ffebld incr, ffelexToken incr_token,
-				  const char *msg);
-static void ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr,
-				tree itersvar);
-static void ffeste_io_call_ (tree call, bool do_check);
-static void ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token);
-static tree ffeste_io_dofio_ (ffebld expr);
-static tree ffeste_io_dolio_ (ffebld expr);
-static tree ffeste_io_douio_ (ffebld expr);
-static tree ffeste_io_ialist_ (bool have_err, ffestvUnit unit,
-			       ffebld unit_expr, int unit_dflt);
-static tree ffeste_io_cilist_ (bool have_err, ffestvUnit unit,
-			       ffebld unit_expr, int unit_dflt,
-			       bool have_end, ffestvFormat format,
-			       ffestpFile *format_spec, bool rec,
-			       ffebld rec_expr);
-static tree ffeste_io_cllist_ (bool have_err, ffebld unit_expr,
-			       ffestpFile *stat_spec);
-static tree ffeste_io_icilist_ (bool have_err, ffebld unit_expr,
-				bool have_end, ffestvFormat format,
-				ffestpFile *format_spec);
-static tree ffeste_io_inlist_ (bool have_err,
-			       ffestpFile *unit_spec,
-			       ffestpFile *file_spec,
-			       ffestpFile *exist_spec,
-			       ffestpFile *open_spec,
-			       ffestpFile *number_spec,
-			       ffestpFile *named_spec,
-			       ffestpFile *name_spec,
-			       ffestpFile *access_spec,
-			       ffestpFile *sequential_spec,
-			       ffestpFile *direct_spec,
-			       ffestpFile *form_spec,
-			       ffestpFile *formatted_spec,
-			       ffestpFile *unformatted_spec,
-			       ffestpFile *recl_spec,
-			       ffestpFile *nextrec_spec,
-			       ffestpFile *blank_spec);
-static tree ffeste_io_olist_ (bool have_err, ffebld unit_expr,
-			      ffestpFile *file_spec,
-			      ffestpFile *stat_spec,
-			      ffestpFile *access_spec,
-			      ffestpFile *form_spec,
-			      ffestpFile *recl_spec,
-			      ffestpFile *blank_spec);
-static void ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt);
-
-/* Internal macros. */
-
-#define ffeste_emit_line_note_() \
-  emit_line_note (input_location)
-#define ffeste_check_simple_() \
-  assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_)
-#define ffeste_check_start_() \
-  assert(ffeste_statelet_ == FFESTE_stateletSIMPLE_); \
-  ffeste_statelet_ = FFESTE_stateletATTRIB_
-#define ffeste_check_attrib_() \
-  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_)
-#define ffeste_check_item_() \
-  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_	 \
-	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
-  ffeste_statelet_ = FFESTE_stateletITEM_
-#define ffeste_check_item_startvals_() \
-  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_	 \
-	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
-  ffeste_statelet_ = FFESTE_stateletITEMVALS_
-#define ffeste_check_item_value_() \
-  assert(ffeste_statelet_ == FFESTE_stateletITEMVALS_)
-#define ffeste_check_item_endvals_() \
-  assert(ffeste_statelet_ == FFESTE_stateletITEMVALS_); \
-  ffeste_statelet_ = FFESTE_stateletITEM_
-#define ffeste_check_finish_() \
-  assert(ffeste_statelet_ == FFESTE_stateletATTRIB_	 \
-	 || ffeste_statelet_ == FFESTE_stateletITEM_); \
-  ffeste_statelet_ = FFESTE_stateletSIMPLE_
-
-#define ffeste_f2c_init_charnolen_(Exp,Init,Spec)			      \
-  do									      \
-    {									      \
-      if ((Spec)->kw_or_val_present)					      \
-	Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, &ignore);	      \
-      else								      \
-	Exp = null_pointer_node;					      \
-      if (Exp)								      \
-	Init = Exp;							      \
-      else								      \
-	{								      \
-	  Init = null_pointer_node;					      \
-	  constantp = FALSE;						      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_init_char_(Exp,Init,Lenexp,Leninit,Spec)		      \
-  do									      \
-    {									      \
-      if ((Spec)->kw_or_val_present)					      \
-	Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, &Lenexp);	      \
-      else								      \
-	{								      \
-	  Exp = null_pointer_node;					      \
-	  Lenexp = ffecom_f2c_ftnlen_zero_node;				      \
-	}								      \
-      if (Exp)								      \
-	Init = Exp;							      \
-      else								      \
-	{								      \
-	  Init = null_pointer_node;					      \
-	  constantp = FALSE;						      \
-	}								      \
-      if (Lenexp)							      \
-	Leninit = Lenexp;						      \
-      else								      \
-	{								      \
-	  Leninit = ffecom_f2c_ftnlen_zero_node;			      \
-	  constantp = FALSE;						      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_init_flag_(Flag,Init)				      \
-  do									      \
-    {									      \
-      Init = convert (ffecom_f2c_flag_type_node,			      \
-		      (Flag) ? integer_one_node : integer_zero_node);	      \
-    } while(0)
-
-#define ffeste_f2c_init_format_(Exp,Init,Spec)				      \
-  do									      \
-    {									      \
-      Exp = ffecom_arg_ptr_to_const_expr ((Spec)->u.expr, NULL);	      \
-      if (Exp)								      \
-	Init = Exp;							      \
-      else								      \
-	{								      \
-	  Init = null_pointer_node;					      \
-	  constantp = FALSE;						      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_init_int_(Exp,Init,Spec)				      \
-  do									      \
-    {									      \
-      if ((Spec)->kw_or_val_present)					      \
-	Exp = ffecom_const_expr ((Spec)->u.expr);			      \
-      else								      \
-	Exp = ffecom_integer_zero_node;					      \
-      if (Exp)								      \
-	Init = Exp;							      \
-      else								      \
-	{								      \
-	  Init = ffecom_integer_zero_node;				      \
-	  constantp = FALSE;						      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_init_ptrtoint_(Exp,Init,Spec)			      \
-  do									      \
-    {									      \
-      if ((Spec)->kw_or_val_present)					      \
-	Exp = ffecom_ptr_to_const_expr ((Spec)->u.expr);		      \
-      else								      \
-	Exp = null_pointer_node;					      \
-      if (Exp)								      \
-	Init = Exp;							      \
-      else								      \
-	{								      \
-	  Init = null_pointer_node;					      \
-	  constantp = FALSE;						      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_init_next_(Init)					      \
-  do									      \
-    {									      \
-      TREE_CHAIN (initn) = build_tree_list ((field = TREE_CHAIN (field)),     \
-					    (Init));			      \
-      initn = TREE_CHAIN(initn);					      \
-    } while(0)
-
-#define ffeste_f2c_prepare_charnolen_(Spec,Exp)				      \
-  do									      \
-    {									      \
-      if (! (Exp))							      \
-        ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr);		      \
-    } while(0)
-
-#define ffeste_f2c_prepare_char_(Spec,Exp)				      \
-  do									      \
-    {									      \
-      if (! (Exp))							      \
-        ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr);		      \
-    } while(0)
-
-#define ffeste_f2c_prepare_format_(Spec,Exp)				      \
-  do									      \
-    {									      \
-      if (! (Exp))							      \
-        ffecom_prepare_arg_ptr_to_expr ((Spec)->u.expr);		      \
-    } while(0)
-
-#define ffeste_f2c_prepare_int_(Spec,Exp)				      \
-  do									      \
-    {									      \
-      if (! (Exp))							      \
-        ffecom_prepare_expr ((Spec)->u.expr);				      \
-    } while(0)
-
-#define ffeste_f2c_prepare_ptrtoint_(Spec,Exp)				      \
-  do									      \
-    {									      \
-      if (! (Exp))							      \
-        ffecom_prepare_ptr_to_expr ((Spec)->u.expr);			      \
-    } while(0)
-
-#define ffeste_f2c_compile_(Field,Exp)					      \
-  do									      \
-    {									      \
-      tree exz;								      \
-      if ((Exp))							      \
-	{								      \
-	  exz = ffecom_modify (void_type_node,				      \
-			       ffecom_2 (COMPONENT_REF, TREE_TYPE (Field),    \
-					 t, (Field)),			      \
-			       (Exp));					      \
-	  expand_expr_stmt (exz);					      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_compile_charnolen_(Field,Spec,Exp)			      \
-  do									      \
-    {									      \
-      tree exq;								      \
-      if (! (Exp))							      \
-	{								      \
-	  exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &ignore);	      \
-	  ffeste_f2c_compile_ ((Field), exq);				      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_compile_char_(Field,Lenfield,Spec,Exp,Lenexp)	      \
-  do									      \
-    {									      \
-      tree exq = (Exp);							      \
-      tree lenexq = (Lenexp);						      \
-      int need_exq = (! exq);						      \
-      int need_lenexq = (! lenexq);					      \
-      if (need_exq || need_lenexq)					      \
-	{								      \
-	  exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, &lenexq);	      \
-	  if (need_exq)							      \
-	    ffeste_f2c_compile_ ((Field), exq);				      \
-	  if (need_lenexq)						      \
-	    ffeste_f2c_compile_ ((Lenfield), lenexq);			      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_compile_format_(Field,Spec,Exp)			      \
-  do									      \
-    {									      \
-      tree exq;								      \
-      if (! (Exp))							      \
-	{								      \
-	  exq = ffecom_arg_ptr_to_expr ((Spec)->u.expr, NULL);		      \
-	  ffeste_f2c_compile_ ((Field), exq);				      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_compile_int_(Field,Spec,Exp)				      \
-  do									      \
-    {									      \
-      tree exq;								      \
-      if (! (Exp))							      \
-	{								      \
-	  exq = ffecom_expr ((Spec)->u.expr);				      \
-	  ffeste_f2c_compile_ ((Field), exq);				      \
-	}								      \
-    } while(0)
-
-#define ffeste_f2c_compile_ptrtoint_(Field,Spec,Exp)			      \
-  do									      \
-    {									      \
-      tree exq;								      \
-      if (! (Exp))							      \
-	{								      \
-	  exq = ffecom_ptr_to_expr ((Spec)->u.expr);			      \
-	  ffeste_f2c_compile_ ((Field), exq);				      \
-	}								      \
-    } while(0)
-
-/* Start a Fortran block.  */
-
-#ifdef ENABLE_CHECKING
-
-typedef struct gbe_block
-{
-  struct gbe_block *outer;
-  ffestw block;
-  location_t location;
-  bool is_stmt;
-} *gbe_block;
-
-gbe_block ffeste_top_block_ = NULL;
-
-static void
-ffeste_start_block_ (ffestw block)
-{
-  gbe_block b = xmalloc (sizeof (*b));
-
-  b->outer = ffeste_top_block_;
-  b->block = block;
-  b->location = input_location;
-  b->is_stmt = FALSE;
-
-  ffeste_top_block_ = b;
-
-  ffecom_start_compstmt ();
-}
-
-/* End a Fortran block.  */
-
-static void
-ffeste_end_block_ (ffestw block)
-{
-  gbe_block b = ffeste_top_block_;
-
-  assert (b);
-  assert (! b->is_stmt);
-  assert (b->block == block);
-  assert (! b->is_stmt);
-
-  ffeste_top_block_ = b->outer;
-
-  free (b);
-
-  ffecom_end_compstmt ();
-}
-
-/* Start a Fortran statement.
-
-   Starts a back-end block, so temporaries can be managed, clean-ups
-   properly handled, etc.  Nesting of statements *is* allowed -- the
-   handling of I/O items, even implied-DO I/O lists, within a READ,
-   PRINT, or WRITE statement is one example.  */
-
-static void
-ffeste_start_stmt_(void)
-{
-  gbe_block b = xmalloc (sizeof (*b));
-
-  b->outer = ffeste_top_block_;
-  b->block = NULL;
-  b->location = input_location;
-  b->is_stmt = TRUE;
-
-  ffeste_top_block_ = b;
-
-  ffecom_start_compstmt ();
-}
-
-/* End a Fortran statement.  */
-
-static void
-ffeste_end_stmt_(void)
-{
-  gbe_block b = ffeste_top_block_;
-
-  assert (b);
-  assert (b->is_stmt);
-
-  ffeste_top_block_ = b->outer;
-
-  free (b);
-
-  ffecom_end_compstmt ();
-}
-
-#else  /* ! defined (ENABLE_CHECKING) */
-
-#define ffeste_start_block_(b) ffecom_start_compstmt ()
-#define ffeste_end_block_(b)	\
-  do				\
-    {				\
-      ffecom_end_compstmt ();	\
-    } while(0)
-#define ffeste_start_stmt_() ffeste_start_block_(NULL)
-#define ffeste_end_stmt_() ffeste_end_block_(NULL)
-
-#endif  /* ! defined (ENABLE_CHECKING) */
-
-/* Begin an iterative DO loop.  Pass the block to start if
-   applicable.  */
-
-static void
-ffeste_begin_iterdo_ (ffestw block, tree *xtvar, tree *xtincr,
-		      tree *xitersvar, ffebld var,
-		      ffebld start, ffelexToken start_token,
-		      ffebld end, ffelexToken end_token,
-		      ffebld incr, ffelexToken incr_token,
-		      const char *msg)
-{
-  tree tvar;
-  tree expr;
-  tree tstart;
-  tree tend;
-  tree tincr;
-  tree tincr_saved;
-  tree niters;
-  struct nesting *expanded_loop;
-
-  /* Want to have tvar, tincr, and niters for the whole loop body. */
-
-  if (block)
-    ffeste_start_block_ (block);
-  else
-    ffeste_start_stmt_ ();
-
-  niters = ffecom_make_tempvar (block ? "do" : "impdo",
-				ffecom_integer_type_node,
-				FFETARGET_charactersizeNONE, -1);
-
-  ffecom_prepare_expr (incr);
-  ffecom_prepare_expr_rw (NULL_TREE, var);
-
-  ffecom_prepare_end ();
-
-  tvar = ffecom_expr_rw (NULL_TREE, var);
-  tincr = ffecom_expr (incr);
-
-  if (TREE_CODE (tvar) == ERROR_MARK
-      || TREE_CODE (tincr) == ERROR_MARK)
-    {
-      if (block)
-	{
-	  ffeste_end_block_ (block);
-	  ffestw_set_do_tvar (block, error_mark_node);
-	}
-      else
-	{
-	  ffeste_end_stmt_ ();
-	  *xtvar = error_mark_node;
-	}
-      return;
-    }
-
-  /* Check whether incr is known to be zero, complain and fix.  */
-
-  if (integer_zerop (tincr) || real_zerop (tincr))
-    {
-      ffebad_start (FFEBAD_DO_STEP_ZERO);
-      ffebad_here (0, ffelex_token_where_line (incr_token),
-		   ffelex_token_where_column (incr_token));
-      ffebad_string (msg);
-      ffebad_finish ();
-      tincr = convert (TREE_TYPE (tvar), integer_one_node);
-    }
-
-  tincr_saved = ffecom_save_tree (tincr);
-
-  /* Want to have tstart, tend for just this statement. */
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_expr (start);
-  ffecom_prepare_expr (end);
-
-  ffecom_prepare_end ();
-
-  tstart = ffecom_expr (start);
-  tend = ffecom_expr (end);
-
-  if (TREE_CODE (tstart) == ERROR_MARK
-      || TREE_CODE (tend) == ERROR_MARK)
-    {
-      ffeste_end_stmt_ ();
-
-      if (block)
-	{
-	  ffeste_end_block_ (block);
-	  ffestw_set_do_tvar (block, error_mark_node);
-	}
-      else
-	{
-	  ffeste_end_stmt_ ();
-	  *xtvar = error_mark_node;
-	}
-      return;
-    }
-
-  /* For warnings only, nothing else happens here.  */
-  {
-    tree try;
-
-    if (! ffe_is_onetrip ())
-      {
-	try = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
-			tend,
-			tstart);
-
-	try = ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
-			try,
-			tincr);
-
-	if (TREE_CODE (TREE_TYPE (tvar)) != REAL_TYPE)
-	  try = ffecom_2 (TRUNC_DIV_EXPR, integer_type_node, try,
-			  tincr);
-	else
-	  try = convert (integer_type_node,
-			 ffecom_2 (RDIV_EXPR, TREE_TYPE (tvar),
-				   try,
-				   tincr));
-
-	/* Warn if loop never executed, since we've done the evaluation
-	   of the unofficial iteration count already.  */
-
-	try = ffecom_truth_value (ffecom_2 (LE_EXPR, integer_type_node,
-					    try,
-					    convert (TREE_TYPE (tvar),
-						     integer_zero_node)));
-
-	if (integer_onep (try))
-	  {
-	    ffebad_start (FFEBAD_DO_NULL);
-	    ffebad_here (0, ffelex_token_where_line (start_token),
-			 ffelex_token_where_column (start_token));
-	    ffebad_string (msg);
-	    ffebad_finish ();
-	  }
-      }
-
-    /* Warn if end plus incr would overflow.  */
-
-    try = ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
-		    tend,
-		    tincr);
-
-    if ((TREE_CODE_CLASS (TREE_CODE (try)) == 'c')
-	&& TREE_CONSTANT_OVERFLOW (try))
-      {
-	ffebad_start (FFEBAD_DO_END_OVERFLOW);
-	ffebad_here (0, ffelex_token_where_line (end_token),
-		     ffelex_token_where_column (end_token));
-	ffebad_string (msg);
-	ffebad_finish ();
-      }
-  }
-
-  /* Do the initial assignment into the DO var.  */
-
-  tstart = ffecom_save_tree (tstart);
-
-  expr = ffecom_2 (MINUS_EXPR, TREE_TYPE (tvar),
-		   tend,
-		   tstart);
-
-  if (! ffe_is_onetrip ())
-    {
-      expr = ffecom_2 (PLUS_EXPR, TREE_TYPE (expr),
-		       expr,
-		       convert (TREE_TYPE (expr), tincr_saved));
-    }
-
-  if (TREE_CODE (TREE_TYPE (tvar)) != REAL_TYPE)
-    expr = ffecom_2 (TRUNC_DIV_EXPR, TREE_TYPE (expr),
-		     expr,
-		     tincr_saved);
-  else
-    expr = ffecom_2 (RDIV_EXPR, TREE_TYPE (expr),
-		     expr,
-		     tincr_saved);
-
-#if 1	/* New, F90-approved approach: convert to default INTEGER. */
-  if (TREE_TYPE (tvar) != error_mark_node)
-    expr = convert (ffecom_integer_type_node, expr);
-#else	/* Old approach; convert to INTEGER unless that's a narrowing. */
-  if ((TREE_TYPE (tvar) != error_mark_node)
-      && ((TREE_CODE (TREE_TYPE (tvar)) != INTEGER_TYPE)
-	  || ((TYPE_SIZE (TREE_TYPE (tvar)) != NULL_TREE)
-	      && ((TREE_CODE (TYPE_SIZE (TREE_TYPE (tvar)))
-		   != INTEGER_CST)
-		  || (TREE_INT_CST_LOW (TYPE_SIZE (TREE_TYPE (tvar)))
-		      <= TREE_INT_CST_LOW (TYPE_SIZE (ffecom_integer_type_node)))))))
-    /* Convert unless promoting INTEGER type of any kind downward to
-       default INTEGER; else leave as, say, INTEGER*8 (long long int).  */
-    expr = convert (ffecom_integer_type_node, expr);
-#endif
-
-  assert (TYPE_MAIN_VARIANT (TREE_TYPE (niters))
-	  == TYPE_MAIN_VARIANT (TREE_TYPE (expr)));
-
-  expr = ffecom_modify (void_type_node, niters, expr);
-  expand_expr_stmt (expr);
-
-  expr = ffecom_modify (void_type_node, tvar, tstart);
-  expand_expr_stmt (expr);
-
-  ffeste_end_stmt_ ();
-
-  expanded_loop = expand_start_loop_continue_elsewhere (!! block);
-  if (block)
-    ffestw_set_do_hook (block, expanded_loop);
-
-  if (! ffe_is_onetrip ())
-    {
-      expr = ffecom_truth_value
-	(ffecom_2 (GE_EXPR, integer_type_node,
-		   ffecom_2 (PREDECREMENT_EXPR,
-			     TREE_TYPE (niters),
-			     niters,
-			     convert (TREE_TYPE (niters),
-				      ffecom_integer_one_node)),
-		   convert (TREE_TYPE (niters),
-			    ffecom_integer_zero_node)));
-
-      expand_exit_loop_top_cond (0, expr);
-    }
-
-  if (block)
-    {
-      ffestw_set_do_tvar (block, tvar);
-      ffestw_set_do_incr_saved (block, tincr_saved);
-      ffestw_set_do_count_var (block, niters);
-    }
-  else
-    {
-      *xtvar = tvar;
-      *xtincr = tincr_saved;
-      *xitersvar = niters;
-    }
-}
-
-/* End an iterative DO loop.  Pass the same iteration variable and increment
-   value trees that were generated in the paired _begin_ call.  */
-
-static void
-ffeste_end_iterdo_ (ffestw block, tree tvar, tree tincr, tree itersvar)
-{
-  tree expr;
-  tree niters = itersvar;
-
-  if (tvar == error_mark_node)
-    return;
-
-  expand_loop_continue_here ();
-
-  ffeste_start_stmt_ ();
-
-  if (ffe_is_onetrip ())
-    {
-      expr = ffecom_truth_value
-	(ffecom_2 (GE_EXPR, integer_type_node,
-		   ffecom_2 (PREDECREMENT_EXPR,
-			     TREE_TYPE (niters),
-			     niters,
-			     convert (TREE_TYPE (niters),
-				      ffecom_integer_one_node)),
-		   convert (TREE_TYPE (niters),
-			    ffecom_integer_zero_node)));
-
-      expand_exit_loop_if_false (0, expr);
-    }
-
-  expr = ffecom_modify (void_type_node, tvar,
-			ffecom_2 (PLUS_EXPR, TREE_TYPE (tvar),
-				  tvar,
-				  tincr));
-  expand_expr_stmt (expr);
-
-  /* Lose the stuff we just built. */
-  ffeste_end_stmt_ ();
-
-  expand_end_loop ();
-
-  /* Lose the tvar and incr_saved trees. */
-  if (block)
-    ffeste_end_block_ (block);
-  else
-    ffeste_end_stmt_ ();
-}
-
-/* Generate call to run-time I/O routine.  */
-
-static void
-ffeste_io_call_ (tree call, bool do_check)
-{
-  /* Generate the call and optional assignment into iostat var. */
-
-  TREE_SIDE_EFFECTS (call) = 1;
-  if (ffeste_io_iostat_ != NULL_TREE)
-    call = ffecom_modify (do_check ? NULL_TREE : void_type_node,
-			  ffeste_io_iostat_, call);
-  expand_expr_stmt (call);
-
-  if (! do_check
-      || ffeste_io_abort_ == NULL_TREE
-      || TREE_CODE (ffeste_io_abort_) == ERROR_MARK)
-    return;
-
-  /* Generate optional test. */
-
-  expand_start_cond (ffecom_truth_value (ffeste_io_iostat_), 0);
-  expand_goto (ffeste_io_abort_);
-  expand_end_cond ();
-}
-
-/* Handle implied-DO in I/O list.
-
-   Expands code to start up the DO loop.  Then for each item in the
-   DO loop, handles appropriately (possibly including recursively calling
-   itself).  Then expands code to end the DO loop.  */
-
-static void
-ffeste_io_impdo_ (ffebld impdo, ffelexToken impdo_token)
-{
-  ffebld var = ffebld_head (ffebld_right (impdo));
-  ffebld start = ffebld_head (ffebld_trail (ffebld_right (impdo)));
-  ffebld end = ffebld_head (ffebld_trail (ffebld_trail
-					  (ffebld_right (impdo))));
-  ffebld incr = ffebld_head (ffebld_trail (ffebld_trail
-				    (ffebld_trail (ffebld_right (impdo)))));
-  ffebld list;
-  ffebld item;
-  tree tvar;
-  tree tincr;
-  tree titervar;
-
-  if (incr == NULL)
-    {
-      incr = ffebld_new_conter (ffebld_constant_new_integerdefault_val (1));
-      ffebld_set_info (incr, ffeinfo_new
-		       (FFEINFO_basictypeINTEGER,
-			FFEINFO_kindtypeINTEGERDEFAULT,
-			0,
-			FFEINFO_kindENTITY,
-			FFEINFO_whereCONSTANT,
-			FFETARGET_charactersizeNONE));
-    }
-
-  /* Start the DO loop.  */
-
-  start = ffeexpr_convert_expr (start, impdo_token, var, impdo_token,
-				FFEEXPR_contextLET);
-  end = ffeexpr_convert_expr (end, impdo_token, var, impdo_token,
-			      FFEEXPR_contextLET);
-  incr = ffeexpr_convert_expr (incr, impdo_token, var, impdo_token,
-			       FFEEXPR_contextLET);
-
-  ffeste_begin_iterdo_ (NULL, &tvar, &tincr, &titervar, var,
-			start, impdo_token,
-			end, impdo_token,
-			incr, impdo_token,
-			"Implied DO loop");
-
-  /* Handle the list of items.  */
-
-  for (list = ffebld_left (impdo); list != NULL; list = ffebld_trail (list))
-    {
-      item = ffebld_head (list);
-      if (item == NULL)
-	continue;
-
-      /* Strip parens off items such as in "READ *,(A)".  This is really a bug
-	 in the user's code, but I've been told lots of code does this.  */
-      while (ffebld_op (item) == FFEBLD_opPAREN)
-	item = ffebld_left (item);
-
-      if (ffebld_op (item) == FFEBLD_opANY)
-	continue;
-
-      if (ffebld_op (item) == FFEBLD_opIMPDO)
-	ffeste_io_impdo_ (item, impdo_token);
-      else
-	{
-	  ffeste_start_stmt_ ();
-
-	  ffecom_prepare_arg_ptr_to_expr (item);
-
-	  ffecom_prepare_end ();
-
-	  ffeste_io_call_ ((*ffeste_io_driver_) (item), TRUE);
-
-	  ffeste_end_stmt_ ();
-	}
-    }
-
-  /* Generate end of implied-do construct. */
-
-  ffeste_end_iterdo_ (NULL, tvar, tincr, titervar);
-}
-
-/* I/O driver for formatted I/O item (do_fio)
-
-   Returns a tree for a CALL_EXPR to the do_fio function, which handles
-   a formatted I/O list item, along with the appropriate arguments for
-   the function.  It is up to the caller to set the TREE_SIDE_EFFECTS flag
-   for the CALL_EXPR, expand (emit) the expression, emit any assignment
-   of the result to an IOSTAT= variable, and emit any checking of the
-   result for errors.  */
-
-static tree
-ffeste_io_dofio_ (ffebld expr)
-{
-  tree num_elements;
-  tree variable;
-  tree size;
-  tree arglist;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  bool is_complex;
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-
-  if ((bt == FFEINFO_basictypeANY)
-      || (kt == FFEINFO_kindtypeANY))
-    return error_mark_node;
-
-  if (bt == FFEINFO_basictypeCOMPLEX)
-    {
-      is_complex = TRUE;
-      bt = FFEINFO_basictypeREAL;
-    }
-  else
-    is_complex = FALSE;
-
-  variable = ffecom_arg_ptr_to_expr (expr, &size);
-
-  if ((variable == error_mark_node)
-      || (size == error_mark_node))
-    return error_mark_node;
-
-  if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
-    {				/* "(ftnlen) sizeof(type)" */
-      size = size_binop (CEIL_DIV_EXPR,
-			 TYPE_SIZE_UNIT (ffecom_tree_type[bt][kt]),
-			 size_int (TYPE_PRECISION (char_type_node)
-				   / BITS_PER_UNIT));
-#if 0	/* Assume that while it is possible that char * is wider than
-	   ftnlen, no object in Fortran space can get big enough for its
-	   size to be wider than ftnlen.  I really hope nobody wastes
-	   time debugging a case where it can!  */
-      assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
-	      >= TYPE_PRECISION (TREE_TYPE (size)));
-#endif
-      size = convert (ffecom_f2c_ftnlen_type_node, size);
-    }
-
-  if (ffeinfo_rank (ffebld_info (expr)) == 0
-      || TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE)
-    num_elements
-      = is_complex ? ffecom_f2c_ftnlen_two_node : ffecom_f2c_ftnlen_one_node;
-  else
-    {
-      num_elements
-	= size_binop (CEIL_DIV_EXPR,
-		      TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (variable))),
-		      convert (sizetype, size));
-      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
-				 size_int (TYPE_PRECISION (char_type_node)
-					   / BITS_PER_UNIT));
-      num_elements = convert (ffecom_f2c_ftnlen_type_node,
-			      num_elements);
-    }
-
-  num_elements
-    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
-		num_elements);
-
-  variable = convert (string_type_node, variable);
-
-  arglist = build_tree_list (NULL_TREE, num_elements);
-  TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
-  TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size);
-
-  return ffecom_call_gfrt (FFECOM_gfrtDOFIO, arglist, NULL_TREE);
-}
-
-/* I/O driver for list-directed I/O item (do_lio)
-
-   Returns a tree for a CALL_EXPR to the do_lio function, which handles
-   a list-directed I/O list item, along with the appropriate arguments for
-   the function.  It is up to the caller to set the TREE_SIDE_EFFECTS flag
-   for the CALL_EXPR, expand (emit) the expression, emit any assignment
-   of the result to an IOSTAT= variable, and emit any checking of the
-   result for errors.  */
-
-static tree
-ffeste_io_dolio_ (ffebld expr)
-{
-  tree type_id;
-  tree num_elements;
-  tree variable;
-  tree size;
-  tree arglist;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  int tc;
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-
-  if ((bt == FFEINFO_basictypeANY)
-      || (kt == FFEINFO_kindtypeANY))
-    return error_mark_node;
-
-  tc = ffecom_f2c_typecode (bt, kt);
-  assert (tc != -1);
-  type_id = build_int_2 (tc, 0);
-
-  type_id
-    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnint_type_node,
-		convert (ffecom_f2c_ftnint_type_node,
-			 type_id));
-
-  variable = ffecom_arg_ptr_to_expr (expr, &size);
-
-  if ((type_id == error_mark_node)
-      || (variable == error_mark_node)
-      || (size == error_mark_node))
-    return error_mark_node;
-
-  if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
-    {				/* "(ftnlen) sizeof(type)" */
-      size = size_binop (CEIL_DIV_EXPR,
-			 TYPE_SIZE_UNIT (ffecom_tree_type[bt][kt]),
-			 size_int (TYPE_PRECISION (char_type_node)
-				   / BITS_PER_UNIT));
-#if 0	/* Assume that while it is possible that char * is wider than
-	   ftnlen, no object in Fortran space can get big enough for its
-	   size to be wider than ftnlen.  I really hope nobody wastes
-	   time debugging a case where it can!  */
-      assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
-	      >= TYPE_PRECISION (TREE_TYPE (size)));
-#endif
-      size = convert (ffecom_f2c_ftnlen_type_node, size);
-    }
-
-  if (ffeinfo_rank (ffebld_info (expr)) == 0
-      || TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE)
-    num_elements = ffecom_integer_one_node;
-  else
-    {
-      num_elements
-	= size_binop (CEIL_DIV_EXPR,
-		      TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (variable))),
-		      convert (sizetype, size));
-      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
-				 size_int (TYPE_PRECISION (char_type_node)
-					   / BITS_PER_UNIT));
-      num_elements = convert (ffecom_f2c_ftnlen_type_node,
-			      num_elements);
-    }
-
-  num_elements
-    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
-		num_elements);
-
-  variable = convert (string_type_node, variable);
-
-  arglist = build_tree_list (NULL_TREE, type_id);
-  TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, num_elements);
-  TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, variable);
-  TREE_CHAIN (TREE_CHAIN (TREE_CHAIN (arglist)))
-    = build_tree_list (NULL_TREE, size);
-
-  return ffecom_call_gfrt (FFECOM_gfrtDOLIO, arglist, NULL_TREE);
-}
-
-/* I/O driver for unformatted I/O item (do_uio)
-
-   Returns a tree for a CALL_EXPR to the do_uio function, which handles
-   an unformatted I/O list item, along with the appropriate arguments for
-   the function.  It is up to the caller to set the TREE_SIDE_EFFECTS flag
-   for the CALL_EXPR, expand (emit) the expression, emit any assignment
-   of the result to an IOSTAT= variable, and emit any checking of the
-   result for errors.  */
-
-static tree
-ffeste_io_douio_ (ffebld expr)
-{
-  tree num_elements;
-  tree variable;
-  tree size;
-  tree arglist;
-  ffeinfoBasictype bt;
-  ffeinfoKindtype kt;
-  bool is_complex;
-
-  bt = ffeinfo_basictype (ffebld_info (expr));
-  kt = ffeinfo_kindtype (ffebld_info (expr));
-
-  if ((bt == FFEINFO_basictypeANY)
-      || (kt == FFEINFO_kindtypeANY))
-    return error_mark_node;
-
-  if (bt == FFEINFO_basictypeCOMPLEX)
-    {
-      is_complex = TRUE;
-      bt = FFEINFO_basictypeREAL;
-    }
-  else
-    is_complex = FALSE;
-
-  variable = ffecom_arg_ptr_to_expr (expr, &size);
-
-  if ((variable == error_mark_node)
-      || (size == error_mark_node))
-    return error_mark_node;
-
-  if (size == NULL_TREE)	/* Already filled in for CHARACTER type. */
-    {				/* "(ftnlen) sizeof(type)" */
-      size = size_binop (CEIL_DIV_EXPR,
-			 TYPE_SIZE_UNIT (ffecom_tree_type[bt][kt]),
-			 size_int (TYPE_PRECISION (char_type_node)
-				   / BITS_PER_UNIT));
-#if 0	/* Assume that while it is possible that char * is wider than
-	   ftnlen, no object in Fortran space can get big enough for its
-	   size to be wider than ftnlen.  I really hope nobody wastes
-	   time debugging a case where it can!  */
-      assert (TYPE_PRECISION (ffecom_f2c_ftnlen_type_node)
-	      >= TYPE_PRECISION (TREE_TYPE (size)));
-#endif
-      size = convert (ffecom_f2c_ftnlen_type_node, size);
-    }
-
-  if (ffeinfo_rank (ffebld_info (expr)) == 0
-      || TREE_CODE (TREE_TYPE (TREE_TYPE (variable))) != ARRAY_TYPE)
-    num_elements
-      = is_complex ? ffecom_f2c_ftnlen_two_node : ffecom_f2c_ftnlen_one_node;
-  else
-    {
-      num_elements
-	= size_binop (CEIL_DIV_EXPR,
-		      TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (variable))),
-		      convert (sizetype, size));
-      num_elements = size_binop (CEIL_DIV_EXPR, num_elements,
-				 size_int (TYPE_PRECISION (char_type_node)
-					   / BITS_PER_UNIT));
-      num_elements = convert (ffecom_f2c_ftnlen_type_node,
-			      num_elements);
-    }
-
-  num_elements
-    = ffecom_1 (ADDR_EXPR, ffecom_f2c_ptr_to_ftnlen_type_node,
-		num_elements);
-
-  variable = convert (string_type_node, variable);
-
-  arglist = build_tree_list (NULL_TREE, num_elements);
-  TREE_CHAIN (arglist) = build_tree_list (NULL_TREE, variable);
-  TREE_CHAIN (TREE_CHAIN (arglist)) = build_tree_list (NULL_TREE, size);
-
-  return ffecom_call_gfrt (FFECOM_gfrtDOUIO, arglist, NULL_TREE);
-}
-
-/* Make arglist with ptr to BACKSPACE/ENDFILE/REWIND control list.
-
-   Returns a tree suitable as an argument list containing a pointer to
-   a BACKSPACE/ENDFILE/REWIND control list.  First, generates that control
-   list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.
-
-   Must ensure that all expressions are prepared before being evaluated,
-   for any whose evaluation might result in the generation of temporaries.
-
-   Note that this means this function causes a transition, within the
-   current block being code-generated via the back end, from the
-   declaration of variables (temporaries) to the expanding of expressions,
-   statements, etc.  */
-
-static GTY(()) tree f2c_alist_struct;
-static tree
-ffeste_io_ialist_ (bool have_err,
-		   ffestvUnit unit,
-		   ffebld unit_expr,
-		   int unit_dflt)
-{
-  tree t;
-  tree ttype;
-  tree field;
-  tree inits, initn;
-  bool constantp = TRUE;
-  static tree errfield, unitfield;
-  tree errinit, unitinit;
-  tree unitexp;
-  static int mynumber = 0;
-
-  if (f2c_alist_struct == NULL_TREE)
-    {
-      tree ref;
-
-      ref = make_node (RECORD_TYPE);
-
-      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
-				    ffecom_f2c_flag_type_node);
-      unitfield = ffecom_decl_field (ref, errfield, "unit",
-				     ffecom_f2c_ftnint_type_node);
-
-      TYPE_FIELDS (ref) = errfield;
-      layout_type (ref);
-
-      f2c_alist_struct = ref;
-    }
-
-  /* Try to do as much compile-time initialization of the structure
-     as possible, to save run time.  */
-
-  ffeste_f2c_init_flag_ (have_err, errinit);
-
-  switch (unit)
-    {
-    case FFESTV_unitNONE:
-    case FFESTV_unitASTERISK:
-      unitinit = build_int_2 (unit_dflt, 0);
-      unitexp = unitinit;
-      break;
-
-    case FFESTV_unitINTEXPR:
-      unitexp = ffecom_const_expr (unit_expr);
-      if (unitexp)
-	unitinit = unitexp;
-      else
-	{
-	  unitinit = ffecom_integer_zero_node;
-	  constantp = FALSE;
-	}
-      break;
-
-    default:
-      assert ("bad unit spec" == NULL);
-      unitinit = ffecom_integer_zero_node;
-      unitexp = unitinit;
-      break;
-    }
-
-  inits = build_tree_list ((field = TYPE_FIELDS (f2c_alist_struct)), errinit);
-  initn = inits;
-  ffeste_f2c_init_next_ (unitinit);
-
-  inits = build_constructor (f2c_alist_struct, inits);
-  TREE_CONSTANT (inits) = constantp ? 1 : 0;
-  TREE_STATIC (inits) = 1;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_alist_%d",
-						  mynumber++),
-		  f2c_alist_struct);
-  TREE_STATIC (t) = 1;
-  t = ffecom_start_decl (t, 1);
-  ffecom_finish_decl (t, inits, 0);
-
-  /* Prepare run-time expressions.  */
-
-  if (! unitexp)
-    ffecom_prepare_expr (unit_expr);
-
-  ffecom_prepare_end ();
-
-  /* Now evaluate run-time expressions as needed.  */
-
-  if (! unitexp)
-    {
-      unitexp = ffecom_expr (unit_expr);
-      ffeste_f2c_compile_ (unitfield, unitexp);
-    }
-
-  ttype = build_pointer_type (TREE_TYPE (t));
-  t = ffecom_1 (ADDR_EXPR, ttype, t);
-
-  t = build_tree_list (NULL_TREE, t);
-
-  return t;
-}
-
-/* Make arglist with ptr to external-I/O control list.
-
-   Returns a tree suitable as an argument list containing a pointer to
-   an external-I/O control list.  First, generates that control
-   list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.
-
-   Must ensure that all expressions are prepared before being evaluated,
-   for any whose evaluation might result in the generation of temporaries.
-
-   Note that this means this function causes a transition, within the
-   current block being code-generated via the back end, from the
-   declaration of variables (temporaries) to the expanding of expressions,
-   statements, etc.  */
-
-static GTY(()) tree f2c_cilist_struct;
-static tree
-ffeste_io_cilist_ (bool have_err,
-		   ffestvUnit unit,
-		   ffebld unit_expr,
-		   int unit_dflt,
-		   bool have_end,
-		   ffestvFormat format,
-		   ffestpFile *format_spec,
-		   bool rec,
-		   ffebld rec_expr)
-{
-  tree t;
-  tree ttype;
-  tree field;
-  tree inits, initn;
-  bool constantp = TRUE;
-  static tree errfield, unitfield, endfield, formatfield, recfield;
-  tree errinit, unitinit, endinit, formatinit, recinit;
-  tree unitexp, formatexp, recexp;
-  static int mynumber = 0;
-
-  if (f2c_cilist_struct == NULL_TREE)
-    {
-      tree ref;
-
-      ref = make_node (RECORD_TYPE);
-
-      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
-				    ffecom_f2c_flag_type_node);
-      unitfield = ffecom_decl_field (ref, errfield, "unit",
-				     ffecom_f2c_ftnint_type_node);
-      endfield = ffecom_decl_field (ref, unitfield, "end",
-				    ffecom_f2c_flag_type_node);
-      formatfield = ffecom_decl_field (ref, endfield, "format",
-				       string_type_node);
-      recfield = ffecom_decl_field (ref, formatfield, "rec",
-				    ffecom_f2c_ftnint_type_node);
-
-      TYPE_FIELDS (ref) = errfield;
-      layout_type (ref);
-
-      f2c_cilist_struct = ref;
-    }
-
-  /* Try to do as much compile-time initialization of the structure
-     as possible, to save run time.  */
-
-  ffeste_f2c_init_flag_ (have_err, errinit);
-
-  switch (unit)
-    {
-    case FFESTV_unitNONE:
-    case FFESTV_unitASTERISK:
-      unitinit = build_int_2 (unit_dflt, 0);
-      unitexp = unitinit;
-      break;
-
-    case FFESTV_unitINTEXPR:
-      unitexp = ffecom_const_expr (unit_expr);
-      if (unitexp)
-	unitinit = unitexp;
-      else
-	{
-	  unitinit = ffecom_integer_zero_node;
-	  constantp = FALSE;
-	}
-      break;
-
-    default:
-      assert ("bad unit spec" == NULL);
-      unitinit = ffecom_integer_zero_node;
-      unitexp = unitinit;
-      break;
-    }
-
-  switch (format)
-    {
-    case FFESTV_formatNONE:
-      formatinit = null_pointer_node;
-      formatexp = formatinit;
-      break;
-
-    case FFESTV_formatLABEL:
-      formatexp = error_mark_node;
-      formatinit = ffecom_lookup_label (format_spec->u.label);
-      if ((formatinit == NULL_TREE)
-	  || (TREE_CODE (formatinit) == ERROR_MARK))
-	break;
-      formatinit = ffecom_1 (ADDR_EXPR,
-			     build_pointer_type (void_type_node),
-			     formatinit);
-      TREE_CONSTANT (formatinit) = 1;
-      break;
-
-    case FFESTV_formatCHAREXPR:
-      formatexp = ffecom_arg_ptr_to_const_expr (format_spec->u.expr, NULL);
-      if (formatexp)
-	formatinit = formatexp;
-      else
-	{
-	  formatinit = null_pointer_node;
-	  constantp = FALSE;
-	}
-      break;
-
-    case FFESTV_formatASTERISK:
-      formatinit = null_pointer_node;
-      formatexp = formatinit;
-      break;
-
-    case FFESTV_formatINTEXPR:
-      formatinit = null_pointer_node;
-      formatexp = ffecom_expr_assign (format_spec->u.expr);
-      if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp)))
-	  < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
-	error ("ASSIGNed FORMAT specifier is too small");
-      formatexp = convert (string_type_node, formatexp);
-      break;
-
-    case FFESTV_formatNAMELIST:
-      formatinit = ffecom_expr (format_spec->u.expr);
-      formatexp = formatinit;
-      break;
-
-    default:
-      assert ("bad format spec" == NULL);
-      formatinit = integer_zero_node;
-      formatexp = formatinit;
-      break;
-    }
-
-  ffeste_f2c_init_flag_ (have_end, endinit);
-
-  if (rec)
-    recexp = ffecom_const_expr (rec_expr);
-  else
-    recexp = ffecom_integer_zero_node;
-  if (recexp)
-    recinit = recexp;
-  else
-    {
-      recinit = ffecom_integer_zero_node;
-      constantp = FALSE;
-    }
-
-  inits = build_tree_list ((field = TYPE_FIELDS (f2c_cilist_struct)), errinit);
-  initn = inits;
-  ffeste_f2c_init_next_ (unitinit);
-  ffeste_f2c_init_next_ (endinit);
-  ffeste_f2c_init_next_ (formatinit);
-  ffeste_f2c_init_next_ (recinit);
-
-  inits = build_constructor (f2c_cilist_struct, inits);
-  TREE_CONSTANT (inits) = constantp ? 1 : 0;
-  TREE_STATIC (inits) = 1;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_cilist_%d",
-						  mynumber++),
-		  f2c_cilist_struct);
-  TREE_STATIC (t) = 1;
-  t = ffecom_start_decl (t, 1);
-  ffecom_finish_decl (t, inits, 0);
-
-  /* Prepare run-time expressions.  */
-
-  if (! unitexp)
-    ffecom_prepare_expr (unit_expr);
-
-  if (! formatexp)
-    ffecom_prepare_arg_ptr_to_expr (format_spec->u.expr);
-
-  if (! recexp)
-    ffecom_prepare_expr (rec_expr);
-
-  ffecom_prepare_end ();
-
-  /* Now evaluate run-time expressions as needed.  */
-
-  if (! unitexp)
-    {
-      unitexp = ffecom_expr (unit_expr);
-      ffeste_f2c_compile_ (unitfield, unitexp);
-    }
-
-  if (! formatexp)
-    {
-      formatexp = ffecom_arg_ptr_to_expr (format_spec->u.expr, NULL);
-      ffeste_f2c_compile_ (formatfield, formatexp);
-    }
-  else if (format == FFESTV_formatINTEXPR)
-    ffeste_f2c_compile_ (formatfield, formatexp);
-
-  if (! recexp)
-    {
-      recexp = ffecom_expr (rec_expr);
-      ffeste_f2c_compile_ (recfield, recexp);
-    }
-
-  ttype = build_pointer_type (TREE_TYPE (t));
-  t = ffecom_1 (ADDR_EXPR, ttype, t);
-
-  t = build_tree_list (NULL_TREE, t);
-
-  return t;
-}
-
-/* Make arglist with ptr to CLOSE control list.
-
-   Returns a tree suitable as an argument list containing a pointer to
-   a CLOSE-statement control list.  First, generates that control
-   list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.
-
-   Must ensure that all expressions are prepared before being evaluated,
-   for any whose evaluation might result in the generation of temporaries.
-
-   Note that this means this function causes a transition, within the
-   current block being code-generated via the back end, from the
-   declaration of variables (temporaries) to the expanding of expressions,
-   statements, etc.  */
-
-static GTY(()) tree f2c_close_struct;
-static tree
-ffeste_io_cllist_ (bool have_err,
-		   ffebld unit_expr,
-		   ffestpFile *stat_spec)
-{
-  tree t;
-  tree ttype;
-  tree field;
-  tree inits, initn;
-  tree ignore;			/* Ignore length info for certain fields. */
-  bool constantp = TRUE;
-  static tree errfield, unitfield, statfield;
-  tree errinit, unitinit, statinit;
-  tree unitexp, statexp;
-  static int mynumber = 0;
-
-  if (f2c_close_struct == NULL_TREE)
-    {
-      tree ref;
-
-      ref = make_node (RECORD_TYPE);
-
-      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
-				    ffecom_f2c_flag_type_node);
-      unitfield = ffecom_decl_field (ref, errfield, "unit",
-				     ffecom_f2c_ftnint_type_node);
-      statfield = ffecom_decl_field (ref, unitfield, "stat",
-				     string_type_node);
-
-      TYPE_FIELDS (ref) = errfield;
-      layout_type (ref);
-
-      f2c_close_struct = ref;
-    }
-
-  /* Try to do as much compile-time initialization of the structure
-     as possible, to save run time.  */
-
-  ffeste_f2c_init_flag_ (have_err, errinit);
-
-  unitexp = ffecom_const_expr (unit_expr);
-  if (unitexp)
-    unitinit = unitexp;
-  else
-    {
-      unitinit = ffecom_integer_zero_node;
-      constantp = FALSE;
-    }
-
-  ffeste_f2c_init_charnolen_ (statexp, statinit, stat_spec);
-
-  inits = build_tree_list ((field = TYPE_FIELDS (f2c_close_struct)), errinit);
-  initn = inits;
-  ffeste_f2c_init_next_ (unitinit);
-  ffeste_f2c_init_next_ (statinit);
-
-  inits = build_constructor (f2c_close_struct, inits);
-  TREE_CONSTANT (inits) = constantp ? 1 : 0;
-  TREE_STATIC (inits) = 1;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_cllist_%d",
-						  mynumber++),
-		  f2c_close_struct);
-  TREE_STATIC (t) = 1;
-  t = ffecom_start_decl (t, 1);
-  ffecom_finish_decl (t, inits, 0);
-
-  /* Prepare run-time expressions.  */
-
-  if (! unitexp)
-    ffecom_prepare_expr (unit_expr);
-
-  if (! statexp)
-    ffecom_prepare_arg_ptr_to_expr (stat_spec->u.expr);
-
-  ffecom_prepare_end ();
-
-  /* Now evaluate run-time expressions as needed.  */
-
-  if (! unitexp)
-    {
-      unitexp = ffecom_expr (unit_expr);
-      ffeste_f2c_compile_ (unitfield, unitexp);
-    }
-
-  ffeste_f2c_compile_charnolen_ (statfield, stat_spec, statexp);
-
-  ttype = build_pointer_type (TREE_TYPE (t));
-  t = ffecom_1 (ADDR_EXPR, ttype, t);
-
-  t = build_tree_list (NULL_TREE, t);
-
-  return t;
-}
-
-/* Make arglist with ptr to internal-I/O control list.
-
-   Returns a tree suitable as an argument list containing a pointer to
-   an internal-I/O control list.  First, generates that control
-   list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.
-
-   Must ensure that all expressions are prepared before being evaluated,
-   for any whose evaluation might result in the generation of temporaries.
-
-   Note that this means this function causes a transition, within the
-   current block being code-generated via the back end, from the
-   declaration of variables (temporaries) to the expanding of expressions,
-   statements, etc.  */
-
-static GTY(()) tree f2c_icilist_struct;
-static tree
-ffeste_io_icilist_ (bool have_err,
-		    ffebld unit_expr,
-		    bool have_end,
-		    ffestvFormat format,
-		    ffestpFile *format_spec)
-{
-  tree t;
-  tree ttype;
-  tree field;
-  tree inits, initn;
-  bool constantp = TRUE;
-  static tree errfield, unitfield, endfield, formatfield, unitlenfield,
-    unitnumfield;
-  tree errinit, unitinit, endinit, formatinit, unitleninit, unitnuminit;
-  tree unitexp, formatexp, unitlenexp, unitnumexp;
-  static int mynumber = 0;
-
-  if (f2c_icilist_struct == NULL_TREE)
-    {
-      tree ref;
-
-      ref = make_node (RECORD_TYPE);
-
-      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
-				    ffecom_f2c_flag_type_node);
-      unitfield = ffecom_decl_field (ref, errfield, "unit",
-				     string_type_node);
-      endfield = ffecom_decl_field (ref, unitfield, "end",
-				    ffecom_f2c_flag_type_node);
-      formatfield = ffecom_decl_field (ref, endfield, "format",
-				       string_type_node);
-      unitlenfield = ffecom_decl_field (ref, formatfield, "unitlen",
-					ffecom_f2c_ftnint_type_node);
-      unitnumfield = ffecom_decl_field (ref, unitlenfield, "unitnum",
-					ffecom_f2c_ftnint_type_node);
-
-      TYPE_FIELDS (ref) = errfield;
-      layout_type (ref);
-
-      f2c_icilist_struct = ref;
-    }
-
-  /* Try to do as much compile-time initialization of the structure
-     as possible, to save run time.  */
-
-  ffeste_f2c_init_flag_ (have_err, errinit);
-
-  unitexp = ffecom_arg_ptr_to_const_expr (unit_expr, &unitlenexp);
-  if (unitexp)
-    unitinit = unitexp;
-  else
-    {
-      unitinit = null_pointer_node;
-      constantp = FALSE;
-    }
-  if (unitlenexp)
-    unitleninit = unitlenexp;
-  else
-    {
-      unitleninit = ffecom_integer_zero_node;
-      constantp = FALSE;
-    }
-
-  /* Now see if we can fully initialize the number of elements, or
-     if we have to compute that at run time.  */
-  if (ffeinfo_rank (ffebld_info (unit_expr)) == 0
-      || (unitexp
-	  && TREE_CODE (TREE_TYPE (TREE_TYPE (unitexp))) != ARRAY_TYPE))
-    {
-      /* Not an array, so just one element.  */
-      unitnuminit = ffecom_integer_one_node;
-      unitnumexp = unitnuminit;
-    }
-  else if (unitexp && unitlenexp)
-    {
-      /* An array, but all the info is constant, so compute now.  */
-      unitnuminit
-	= size_binop (CEIL_DIV_EXPR,
-		      TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (unitexp))),
-		      convert (sizetype, unitlenexp));
-      unitnuminit = size_binop (CEIL_DIV_EXPR, unitnuminit,
-				size_int (TYPE_PRECISION (char_type_node)
-					  / BITS_PER_UNIT));
-      unitnumexp = unitnuminit;
-    }
-  else
-    {
-      /* Put off computing until run time.  */
-      unitnuminit = ffecom_integer_zero_node;
-      unitnumexp = NULL_TREE;
-      constantp = FALSE;
-    }
-
-  switch (format)
-    {
-    case FFESTV_formatNONE:
-      formatinit = null_pointer_node;
-      formatexp = formatinit;
-      break;
-
-    case FFESTV_formatLABEL:
-      formatexp = error_mark_node;
-      formatinit = ffecom_lookup_label (format_spec->u.label);
-      if ((formatinit == NULL_TREE)
-	  || (TREE_CODE (formatinit) == ERROR_MARK))
-	break;
-      formatinit = ffecom_1 (ADDR_EXPR,
-			     build_pointer_type (void_type_node),
-			     formatinit);
-      TREE_CONSTANT (formatinit) = 1;
-      break;
-
-    case FFESTV_formatCHAREXPR:
-      ffeste_f2c_init_format_ (formatexp, formatinit, format_spec);
-      break;
-
-    case FFESTV_formatASTERISK:
-      formatinit = null_pointer_node;
-      formatexp = formatinit;
-      break;
-
-    case FFESTV_formatINTEXPR:
-      formatinit = null_pointer_node;
-      formatexp = ffecom_expr_assign (format_spec->u.expr);
-      if (GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (formatexp)))
-	  < GET_MODE_SIZE (TYPE_MODE (TREE_TYPE (null_pointer_node))))
-	error ("ASSIGNed FORMAT specifier is too small");
-      formatexp = convert (string_type_node, formatexp);
-      break;
-
-    default:
-      assert ("bad format spec" == NULL);
-      formatinit = ffecom_integer_zero_node;
-      formatexp = formatinit;
-      break;
-    }
-
-  ffeste_f2c_init_flag_ (have_end, endinit);
-
-  inits = build_tree_list ((field = TYPE_FIELDS (f2c_icilist_struct)),
-			   errinit);
-  initn = inits;
-  ffeste_f2c_init_next_ (unitinit);
-  ffeste_f2c_init_next_ (endinit);
-  ffeste_f2c_init_next_ (formatinit);
-  ffeste_f2c_init_next_ (unitleninit);
-  ffeste_f2c_init_next_ (unitnuminit);
-
-  inits = build_constructor (f2c_icilist_struct, inits);
-  TREE_CONSTANT (inits) = constantp ? 1 : 0;
-  TREE_STATIC (inits) = 1;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_icilist_%d",
-						  mynumber++),
-		  f2c_icilist_struct);
-  TREE_STATIC (t) = 1;
-  t = ffecom_start_decl (t, 1);
-  ffecom_finish_decl (t, inits, 0);
-
-  /* Prepare run-time expressions.  */
-
-  if (! unitexp)
-    ffecom_prepare_arg_ptr_to_expr (unit_expr);
-
-  ffeste_f2c_prepare_format_ (format_spec, formatexp);
-
-  ffecom_prepare_end ();
-
-  /* Now evaluate run-time expressions as needed.  */
-
-  if (! unitexp || ! unitlenexp)
-    {
-      int need_unitexp = (! unitexp);
-      int need_unitlenexp = (! unitlenexp);
-
-      unitexp = ffecom_arg_ptr_to_expr (unit_expr, &unitlenexp);
-      if (need_unitexp)
-	ffeste_f2c_compile_ (unitfield, unitexp);
-      if (need_unitlenexp)
-	ffeste_f2c_compile_ (unitlenfield, unitlenexp);
-    }
-
-  if (! unitnumexp
-      && unitexp != error_mark_node
-      && unitlenexp != error_mark_node)
-    {
-      unitnumexp
-	= size_binop (CEIL_DIV_EXPR,
-		      TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (unitexp))),
-		      convert (sizetype, unitlenexp));
-      unitnumexp = size_binop (CEIL_DIV_EXPR, unitnumexp,
-			       size_int (TYPE_PRECISION (char_type_node)
-					 / BITS_PER_UNIT));
-      ffeste_f2c_compile_ (unitnumfield, unitnumexp);
-    }
-
-  if (format == FFESTV_formatINTEXPR)
-    ffeste_f2c_compile_ (formatfield, formatexp);
-  else
-    ffeste_f2c_compile_format_ (formatfield, format_spec, formatexp);
-
-  ttype = build_pointer_type (TREE_TYPE (t));
-  t = ffecom_1 (ADDR_EXPR, ttype, t);
-
-  t = build_tree_list (NULL_TREE, t);
-
-  return t;
-}
-
-/* Make arglist with ptr to INQUIRE control list
-
-   Returns a tree suitable as an argument list containing a pointer to
-   an INQUIRE-statement control list.  First, generates that control
-   list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.
-
-   Must ensure that all expressions are prepared before being evaluated,
-   for any whose evaluation might result in the generation of temporaries.
-
-   Note that this means this function causes a transition, within the
-   current block being code-generated via the back end, from the
-   declaration of variables (temporaries) to the expanding of expressions,
-   statements, etc.  */
-
-static GTY(()) tree f2c_inquire_struct;
-static tree
-ffeste_io_inlist_ (bool have_err,
-		   ffestpFile *unit_spec,
-		   ffestpFile *file_spec,
-		   ffestpFile *exist_spec,
-		   ffestpFile *open_spec,
-		   ffestpFile *number_spec,
-		   ffestpFile *named_spec,
-		   ffestpFile *name_spec,
-		   ffestpFile *access_spec,
-		   ffestpFile *sequential_spec,
-		   ffestpFile *direct_spec,
-		   ffestpFile *form_spec,
-		   ffestpFile *formatted_spec,
-		   ffestpFile *unformatted_spec,
-		   ffestpFile *recl_spec,
-		   ffestpFile *nextrec_spec,
-		   ffestpFile *blank_spec)
-{
-  tree t;
-  tree ttype;
-  tree field;
-  tree inits, initn;
-  bool constantp = TRUE;
-  static tree errfield, unitfield, filefield, filelenfield, existfield,
-    openfield, numberfield, namedfield, namefield, namelenfield, accessfield,
-    accesslenfield, sequentialfield, sequentiallenfield, directfield, directlenfield,
-    formfield, formlenfield, formattedfield, formattedlenfield, unformattedfield,
-    unformattedlenfield, reclfield, nextrecfield, blankfield, blanklenfield;
-  tree errinit, unitinit, fileinit, fileleninit, existinit, openinit, numberinit,
-    namedinit, nameinit, nameleninit, accessinit, accessleninit, sequentialinit,
-    sequentialleninit, directinit, directleninit, forminit, formleninit,
-    formattedinit, formattedleninit, unformattedinit, unformattedleninit,
-    reclinit, nextrecinit, blankinit, blankleninit;
-  tree
-    unitexp, fileexp, filelenexp, existexp, openexp, numberexp, namedexp,
-    nameexp, namelenexp, accessexp, accesslenexp, sequentialexp, sequentiallenexp,
-    directexp, directlenexp, formexp, formlenexp, formattedexp, formattedlenexp,
-    unformattedexp, unformattedlenexp, reclexp, nextrecexp, blankexp, blanklenexp;
-  static int mynumber = 0;
-
-  if (f2c_inquire_struct == NULL_TREE)
-    {
-      tree ref;
-
-      ref = make_node (RECORD_TYPE);
-
-      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
-				    ffecom_f2c_flag_type_node);
-      unitfield = ffecom_decl_field (ref, errfield, "unit",
-				     ffecom_f2c_ftnint_type_node);
-      filefield = ffecom_decl_field (ref, unitfield, "file",
-				     string_type_node);
-      filelenfield = ffecom_decl_field (ref, filefield, "filelen",
-					ffecom_f2c_ftnlen_type_node);
-      existfield = ffecom_decl_field (ref, filelenfield, "exist",
-				      ffecom_f2c_ptr_to_ftnint_type_node);
-      openfield = ffecom_decl_field (ref, existfield, "open",
-				     ffecom_f2c_ptr_to_ftnint_type_node);
-      numberfield = ffecom_decl_field (ref, openfield, "number",
-				       ffecom_f2c_ptr_to_ftnint_type_node);
-      namedfield = ffecom_decl_field (ref, numberfield, "named",
-				      ffecom_f2c_ptr_to_ftnint_type_node);
-      namefield = ffecom_decl_field (ref, namedfield, "name",
-				     string_type_node);
-      namelenfield = ffecom_decl_field (ref, namefield, "namelen",
-					ffecom_f2c_ftnlen_type_node);
-      accessfield = ffecom_decl_field (ref, namelenfield, "access",
-				       string_type_node);
-      accesslenfield = ffecom_decl_field (ref, accessfield, "accesslen",
-					  ffecom_f2c_ftnlen_type_node);
-      sequentialfield = ffecom_decl_field (ref, accesslenfield, "sequential",
-					   string_type_node);
-      sequentiallenfield = ffecom_decl_field (ref, sequentialfield,
-					      "sequentiallen",
-					      ffecom_f2c_ftnlen_type_node);
-      directfield = ffecom_decl_field (ref, sequentiallenfield, "direct",
-				       string_type_node);
-      directlenfield = ffecom_decl_field (ref, directfield, "directlen",
-					  ffecom_f2c_ftnlen_type_node);
-      formfield = ffecom_decl_field (ref, directlenfield, "form",
-				     string_type_node);
-      formlenfield = ffecom_decl_field (ref, formfield, "formlen",
-					ffecom_f2c_ftnlen_type_node);
-      formattedfield = ffecom_decl_field (ref, formlenfield, "formatted",
-					  string_type_node);
-      formattedlenfield = ffecom_decl_field (ref, formattedfield,
-					     "formattedlen",
-					     ffecom_f2c_ftnlen_type_node);
-      unformattedfield = ffecom_decl_field (ref, formattedlenfield,
-					    "unformatted",
-					    string_type_node);
-      unformattedlenfield = ffecom_decl_field (ref, unformattedfield,
-					       "unformattedlen",
-					       ffecom_f2c_ftnlen_type_node);
-      reclfield = ffecom_decl_field (ref, unformattedlenfield, "recl",
-				     ffecom_f2c_ptr_to_ftnint_type_node);
-      nextrecfield = ffecom_decl_field (ref, reclfield, "nextrec",
-					ffecom_f2c_ptr_to_ftnint_type_node);
-      blankfield = ffecom_decl_field (ref, nextrecfield, "blank",
-				      string_type_node);
-      blanklenfield = ffecom_decl_field (ref, blankfield, "blanklen",
-					 ffecom_f2c_ftnlen_type_node);
-
-      TYPE_FIELDS (ref) = errfield;
-      layout_type (ref);
-
-      f2c_inquire_struct = ref;
-    }
-
-  /* Try to do as much compile-time initialization of the structure
-     as possible, to save run time.  */
-
-  ffeste_f2c_init_flag_ (have_err, errinit);
-  ffeste_f2c_init_int_ (unitexp, unitinit, unit_spec);
-  ffeste_f2c_init_char_ (fileexp, fileinit, filelenexp, fileleninit,
-			 file_spec);
-  ffeste_f2c_init_ptrtoint_ (existexp, existinit, exist_spec);
-  ffeste_f2c_init_ptrtoint_ (openexp, openinit, open_spec);
-  ffeste_f2c_init_ptrtoint_ (numberexp, numberinit, number_spec);
-  ffeste_f2c_init_ptrtoint_ (namedexp, namedinit, named_spec);
-  ffeste_f2c_init_char_ (nameexp, nameinit, namelenexp, nameleninit,
-			 name_spec);
-  ffeste_f2c_init_char_ (accessexp, accessinit, accesslenexp,
-			 accessleninit, access_spec);
-  ffeste_f2c_init_char_ (sequentialexp, sequentialinit, sequentiallenexp,
-			 sequentialleninit, sequential_spec);
-  ffeste_f2c_init_char_ (directexp, directinit, directlenexp,
-			 directleninit, direct_spec);
-  ffeste_f2c_init_char_ (formexp, forminit, formlenexp, formleninit,
-			 form_spec);
-  ffeste_f2c_init_char_ (formattedexp, formattedinit,
-			 formattedlenexp, formattedleninit, formatted_spec);
-  ffeste_f2c_init_char_ (unformattedexp, unformattedinit, unformattedlenexp,
-			 unformattedleninit, unformatted_spec);
-  ffeste_f2c_init_ptrtoint_ (reclexp, reclinit, recl_spec);
-  ffeste_f2c_init_ptrtoint_ (nextrecexp, nextrecinit, nextrec_spec);
-  ffeste_f2c_init_char_ (blankexp, blankinit, blanklenexp,
-			 blankleninit, blank_spec);
-
-  inits = build_tree_list ((field = TYPE_FIELDS (f2c_inquire_struct)),
-			   errinit);
-  initn = inits;
-  ffeste_f2c_init_next_ (unitinit);
-  ffeste_f2c_init_next_ (fileinit);
-  ffeste_f2c_init_next_ (fileleninit);
-  ffeste_f2c_init_next_ (existinit);
-  ffeste_f2c_init_next_ (openinit);
-  ffeste_f2c_init_next_ (numberinit);
-  ffeste_f2c_init_next_ (namedinit);
-  ffeste_f2c_init_next_ (nameinit);
-  ffeste_f2c_init_next_ (nameleninit);
-  ffeste_f2c_init_next_ (accessinit);
-  ffeste_f2c_init_next_ (accessleninit);
-  ffeste_f2c_init_next_ (sequentialinit);
-  ffeste_f2c_init_next_ (sequentialleninit);
-  ffeste_f2c_init_next_ (directinit);
-  ffeste_f2c_init_next_ (directleninit);
-  ffeste_f2c_init_next_ (forminit);
-  ffeste_f2c_init_next_ (formleninit);
-  ffeste_f2c_init_next_ (formattedinit);
-  ffeste_f2c_init_next_ (formattedleninit);
-  ffeste_f2c_init_next_ (unformattedinit);
-  ffeste_f2c_init_next_ (unformattedleninit);
-  ffeste_f2c_init_next_ (reclinit);
-  ffeste_f2c_init_next_ (nextrecinit);
-  ffeste_f2c_init_next_ (blankinit);
-  ffeste_f2c_init_next_ (blankleninit);
-
-  inits = build_constructor (f2c_inquire_struct, inits);
-  TREE_CONSTANT (inits) = constantp ? 1 : 0;
-  TREE_STATIC (inits) = 1;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_inlist_%d",
-						  mynumber++),
-		  f2c_inquire_struct);
-  TREE_STATIC (t) = 1;
-  t = ffecom_start_decl (t, 1);
-  ffecom_finish_decl (t, inits, 0);
-
-  /* Prepare run-time expressions.  */
-
-  ffeste_f2c_prepare_int_ (unit_spec, unitexp);
-  ffeste_f2c_prepare_char_ (file_spec, fileexp);
-  ffeste_f2c_prepare_ptrtoint_ (exist_spec, existexp);
-  ffeste_f2c_prepare_ptrtoint_ (open_spec, openexp);
-  ffeste_f2c_prepare_ptrtoint_ (number_spec, numberexp);
-  ffeste_f2c_prepare_ptrtoint_ (named_spec, namedexp);
-  ffeste_f2c_prepare_char_ (name_spec, nameexp);
-  ffeste_f2c_prepare_char_ (access_spec, accessexp);
-  ffeste_f2c_prepare_char_ (sequential_spec, sequentialexp);
-  ffeste_f2c_prepare_char_ (direct_spec, directexp);
-  ffeste_f2c_prepare_char_ (form_spec, formexp);
-  ffeste_f2c_prepare_char_ (formatted_spec, formattedexp);
-  ffeste_f2c_prepare_char_ (unformatted_spec, unformattedexp);
-  ffeste_f2c_prepare_ptrtoint_ (recl_spec, reclexp);
-  ffeste_f2c_prepare_ptrtoint_ (nextrec_spec, nextrecexp);
-  ffeste_f2c_prepare_char_ (blank_spec, blankexp);
-
-  ffecom_prepare_end ();
-
-  /* Now evaluate run-time expressions as needed.  */
-
-  ffeste_f2c_compile_int_ (unitfield, unit_spec, unitexp);
-  ffeste_f2c_compile_char_ (filefield, filelenfield, file_spec,
-			    fileexp, filelenexp);
-  ffeste_f2c_compile_ptrtoint_ (existfield, exist_spec, existexp);
-  ffeste_f2c_compile_ptrtoint_ (openfield, open_spec, openexp);
-  ffeste_f2c_compile_ptrtoint_ (numberfield, number_spec, numberexp);
-  ffeste_f2c_compile_ptrtoint_ (namedfield, named_spec, namedexp);
-  ffeste_f2c_compile_char_ (namefield, namelenfield, name_spec, nameexp,
-			    namelenexp);
-  ffeste_f2c_compile_char_ (accessfield, accesslenfield, access_spec,
-			    accessexp, accesslenexp);
-  ffeste_f2c_compile_char_ (sequentialfield, sequentiallenfield,
-			    sequential_spec, sequentialexp,
-			    sequentiallenexp);
-  ffeste_f2c_compile_char_ (directfield, directlenfield, direct_spec,
-			    directexp, directlenexp);
-  ffeste_f2c_compile_char_ (formfield, formlenfield, form_spec, formexp,
-			    formlenexp);
-  ffeste_f2c_compile_char_ (formattedfield, formattedlenfield, formatted_spec,
-			    formattedexp, formattedlenexp);
-  ffeste_f2c_compile_char_ (unformattedfield, unformattedlenfield,
-			    unformatted_spec, unformattedexp,
-			    unformattedlenexp);
-  ffeste_f2c_compile_ptrtoint_ (reclfield, recl_spec, reclexp);
-  ffeste_f2c_compile_ptrtoint_ (nextrecfield, nextrec_spec, nextrecexp);
-  ffeste_f2c_compile_char_ (blankfield, blanklenfield, blank_spec, blankexp,
-			    blanklenexp);
-
-  ttype = build_pointer_type (TREE_TYPE (t));
-  t = ffecom_1 (ADDR_EXPR, ttype, t);
-
-  t = build_tree_list (NULL_TREE, t);
-
-  return t;
-}
-
-/* Make arglist with ptr to OPEN control list
-
-   Returns a tree suitable as an argument list containing a pointer to
-   an OPEN-statement control list.  First, generates that control
-   list, if necessary, along with any static and run-time initializations
-   that are needed as specified by the arguments to this function.
-
-   Must ensure that all expressions are prepared before being evaluated,
-   for any whose evaluation might result in the generation of temporaries.
-
-   Note that this means this function causes a transition, within the
-   current block being code-generated via the back end, from the
-   declaration of variables (temporaries) to the expanding of expressions,
-   statements, etc.  */
-
-static GTY(()) tree f2c_open_struct;
-static tree
-ffeste_io_olist_ (bool have_err,
-		  ffebld unit_expr,
-		  ffestpFile *file_spec,
-		  ffestpFile *stat_spec,
-		  ffestpFile *access_spec,
-		  ffestpFile *form_spec,
-		  ffestpFile *recl_spec,
-		  ffestpFile *blank_spec)
-{
-  tree t;
-  tree ttype;
-  tree field;
-  tree inits, initn;
-  tree ignore;			/* Ignore length info for certain fields. */
-  bool constantp = TRUE;
-  static tree errfield, unitfield, filefield, filelenfield, statfield,
-    accessfield, formfield, reclfield, blankfield;
-  tree errinit, unitinit, fileinit, fileleninit, statinit, accessinit,
-    forminit, reclinit, blankinit;
-  tree
-    unitexp, fileexp, filelenexp, statexp, accessexp, formexp, reclexp,
-    blankexp;
-  static int mynumber = 0;
-
-  if (f2c_open_struct == NULL_TREE)
-    {
-      tree ref;
-
-      ref = make_node (RECORD_TYPE);
-
-      errfield = ffecom_decl_field (ref, NULL_TREE, "err",
-				    ffecom_f2c_flag_type_node);
-      unitfield = ffecom_decl_field (ref, errfield, "unit",
-				     ffecom_f2c_ftnint_type_node);
-      filefield = ffecom_decl_field (ref, unitfield, "file",
-				     string_type_node);
-      filelenfield = ffecom_decl_field (ref, filefield, "filelen",
-					ffecom_f2c_ftnlen_type_node);
-      statfield = ffecom_decl_field (ref, filelenfield, "stat",
-				     string_type_node);
-      accessfield = ffecom_decl_field (ref, statfield, "access",
-				       string_type_node);
-      formfield = ffecom_decl_field (ref, accessfield, "form",
-				     string_type_node);
-      reclfield = ffecom_decl_field (ref, formfield, "recl",
-				     ffecom_f2c_ftnint_type_node);
-      blankfield = ffecom_decl_field (ref, reclfield, "blank",
-				      string_type_node);
-
-      TYPE_FIELDS (ref) = errfield;
-      layout_type (ref);
-
-      f2c_open_struct = ref;
-    }
-
-  /* Try to do as much compile-time initialization of the structure
-     as possible, to save run time.  */
-
-  ffeste_f2c_init_flag_ (have_err, errinit);
-
-  unitexp = ffecom_const_expr (unit_expr);
-  if (unitexp)
-    unitinit = unitexp;
-  else
-    {
-      unitinit = ffecom_integer_zero_node;
-      constantp = FALSE;
-    }
-
-  ffeste_f2c_init_char_ (fileexp, fileinit, filelenexp, fileleninit,
-			 file_spec);
-  ffeste_f2c_init_charnolen_ (statexp, statinit, stat_spec);
-  ffeste_f2c_init_charnolen_ (accessexp, accessinit, access_spec);
-  ffeste_f2c_init_charnolen_ (formexp, forminit, form_spec);
-  ffeste_f2c_init_int_ (reclexp, reclinit, recl_spec);
-  ffeste_f2c_init_charnolen_ (blankexp, blankinit, blank_spec);
-
-  inits = build_tree_list ((field = TYPE_FIELDS (f2c_open_struct)), errinit);
-  initn = inits;
-  ffeste_f2c_init_next_ (unitinit);
-  ffeste_f2c_init_next_ (fileinit);
-  ffeste_f2c_init_next_ (fileleninit);
-  ffeste_f2c_init_next_ (statinit);
-  ffeste_f2c_init_next_ (accessinit);
-  ffeste_f2c_init_next_ (forminit);
-  ffeste_f2c_init_next_ (reclinit);
-  ffeste_f2c_init_next_ (blankinit);
-
-  inits = build_constructor (f2c_open_struct, inits);
-  TREE_CONSTANT (inits) = constantp ? 1 : 0;
-  TREE_STATIC (inits) = 1;
-
-  t = build_decl (VAR_DECL,
-		  ffecom_get_invented_identifier ("__g77_olist_%d",
-						  mynumber++),
-		  f2c_open_struct);
-  TREE_STATIC (t) = 1;
-  t = ffecom_start_decl (t, 1);
-  ffecom_finish_decl (t, inits, 0);
-
-  /* Prepare run-time expressions.  */
-
-  if (! unitexp)
-    ffecom_prepare_expr (unit_expr);
-
-  ffeste_f2c_prepare_char_ (file_spec, fileexp);
-  ffeste_f2c_prepare_charnolen_ (stat_spec, statexp);
-  ffeste_f2c_prepare_charnolen_ (access_spec, accessexp);
-  ffeste_f2c_prepare_charnolen_ (form_spec, formexp);
-  ffeste_f2c_prepare_int_ (recl_spec, reclexp);
-  ffeste_f2c_prepare_charnolen_ (blank_spec, blankexp);
-
-  ffecom_prepare_end ();
-
-  /* Now evaluate run-time expressions as needed.  */
-
-  if (! unitexp)
-    {
-      unitexp = ffecom_expr (unit_expr);
-      ffeste_f2c_compile_ (unitfield, unitexp);
-    }
-
-  ffeste_f2c_compile_char_ (filefield, filelenfield, file_spec, fileexp,
-			    filelenexp);
-  ffeste_f2c_compile_charnolen_ (statfield, stat_spec, statexp);
-  ffeste_f2c_compile_charnolen_ (accessfield, access_spec, accessexp);
-  ffeste_f2c_compile_charnolen_ (formfield, form_spec, formexp);
-  ffeste_f2c_compile_int_ (reclfield, recl_spec, reclexp);
-  ffeste_f2c_compile_charnolen_ (blankfield, blank_spec, blankexp);
-
-  ttype = build_pointer_type (TREE_TYPE (t));
-  t = ffecom_1 (ADDR_EXPR, ttype, t);
-
-  t = build_tree_list (NULL_TREE, t);
-
-  return t;
-}
-
-/* Generate code for BACKSPACE/ENDFILE/REWIND.  */
-
-static void
-ffeste_subr_beru_ (ffestpBeruStmt *info, ffecomGfrt rt)
-{
-  tree alist;
-  bool iostat;
-  bool errl;
-
-  ffeste_emit_line_note_ ();
-
-#define specified(something) (info->beru_spec[something].kw_or_val_present)
-
-  iostat = specified (FFESTP_beruixIOSTAT);
-  errl = specified (FFESTP_beruixERR);
-
-#undef specified
-
-  /* ~~For now, we assume the unit number is specified and is not ASTERISK,
-     because the FFE doesn't support BACKSPACE(*) and rejects a BACKSPACE
-     without any unit specifier.  f2c, however, supports the former
-     construct.	 When it is time to add this feature to the FFE, which
-     probably is fairly easy, ffestc_R919 and company will want to pass an
-     ffestvUnit indicator of FFESTV_unitINTEXPR or _unitASTERISK to
-     ffeste_R919 and company, and they will want to pass that same value to
-     this function, and that argument will replace the constant _unitINTEXPR_
-     in the call below.	 Right now, the default unit number, 6, is ignored.  */
-
-  ffeste_start_stmt_ ();
-
-  if (errl)
-    {
-      /* Have ERR= specification.   */
-
-      ffeste_io_err_
-	= ffeste_io_abort_
-	= ffecom_lookup_label
-	(info->beru_spec[FFESTP_beruixERR].u.label);
-      ffeste_io_abort_is_temp_ = FALSE;
-    }
-  else
-    {
-      /* No ERR= specification.  */
-
-      ffeste_io_err_ = NULL_TREE;
-
-      if ((ffeste_io_abort_is_temp_ = iostat))
-	ffeste_io_abort_ = ffecom_temp_label ();
-      else
-	ffeste_io_abort_ = NULL_TREE;
-    }
-
-  if (iostat)
-    {
-      /* Have IOSTAT= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = ffecom_expr
-	(info->beru_spec[FFESTP_beruixIOSTAT].u.expr);
-    }
-  else if (ffeste_io_abort_ != NULL_TREE)
-    {
-      /* Have no IOSTAT= but have ERR=.  */
-
-      ffeste_io_iostat_is_temp_ = TRUE;
-      ffeste_io_iostat_
-	= ffecom_make_tempvar ("beru", ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1);
-    }
-  else
-    {
-      /* No IOSTAT= or ERR= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = NULL_TREE;
-    }
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  alist = ffeste_io_ialist_ (errl || iostat, FFESTV_unitINTEXPR,
-			     info->beru_spec[FFESTP_beruixUNIT].u.expr, 6);
-
-  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
-     label, since we're gonna fall through to there anyway. */
-
-  ffeste_io_call_ (ffecom_call_gfrt (rt, alist, NULL_TREE),
-		   ! ffeste_io_abort_is_temp_);
-
-  /* If we've got a temp label, generate its code here. */
-
-  if (ffeste_io_abort_is_temp_)
-    {
-      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-      emit_nop ();
-      expand_label (ffeste_io_abort_);
-
-      assert (ffeste_io_err_ == NULL_TREE);
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* END DO statement
-
-   Also invoked by _labeldef_branch_finish_ (or, in cases
-   of errors, other _labeldef_ functions) when the label definition is
-   for a DO-target (LOOPEND) label, once per matching/outstanding DO
-   block on the stack.  */
-
-void
-ffeste_do (ffestw block)
-{
-  ffeste_emit_line_note_ ();
-
-  if (ffestw_do_tvar (block) == 0)
-    {
-      expand_end_loop ();		/* DO WHILE and just DO. */
-
-      ffeste_end_block_ (block);
-    }
-  else
-    ffeste_end_iterdo_ (block,
-			ffestw_do_tvar (block),
-			ffestw_do_incr_saved (block),
-			ffestw_do_count_var (block));
-}
-
-/* End of statement following logical IF.
-
-   Applies to *only* logical IF, not to IF-THEN.  */
-
-void
-ffeste_end_R807 (void)
-{
-  ffeste_emit_line_note_ ();
-
-  expand_end_cond ();
-
-  ffeste_end_block_ (NULL);
-}
-
-/* Generate "code" for branch label definition.  */
-
-void
-ffeste_labeldef_branch (ffelab label)
-{
-  tree glabel;
-
-  glabel = ffecom_lookup_label (label);
-  assert (glabel != NULL_TREE);
-  if (TREE_CODE (glabel) == ERROR_MARK)
-    return;
-
-  assert (DECL_INITIAL (glabel) == NULL_TREE);
-
-  DECL_INITIAL (glabel) = error_mark_node;
-  DECL_SOURCE_FILE (glabel) = ffelab_definition_filename (label);
-  DECL_SOURCE_LINE (glabel) = ffelab_definition_filelinenum (label);
-
-  emit_nop ();
-
-  expand_label (glabel);
-}
-
-/* Generate "code" for FORMAT label definition.  */
-
-void
-ffeste_labeldef_format (ffelab label)
-{
-  ffeste_label_formatdef_ = label;
-}
-
-/* Assignment statement (outside of WHERE).  */
-
-void
-ffeste_R737A (ffebld dest, ffebld source)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_stmt_ ();
-
-  ffecom_expand_let_stmt (dest, source);
-
-  ffeste_end_stmt_ ();
-}
-
-/* Block IF (IF-THEN) statement.  */
-
-void
-ffeste_R803 (ffestw block, ffebld expr)
-{
-  tree temp;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_block_ (block);
-
-  temp = ffecom_make_tempvar ("ifthen", integer_type_node,
-			      FFETARGET_charactersizeNONE, -1);
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_expr (expr);
-
-  if (ffecom_prepare_end ())
-    {
-      tree result;
-
-      result = ffecom_modify (void_type_node,
-			      temp,
-			      ffecom_truth_value (ffecom_expr (expr)));
-
-      expand_expr_stmt (result);
-
-      ffeste_end_stmt_ ();
-    }
-  else
-    {
-      ffeste_end_stmt_ ();
-
-      temp = ffecom_truth_value (ffecom_expr (expr));
-    }
-
-  expand_start_cond (temp, 0);
-
-  /* No fake `else' constructs introduced (yet).  */
-  ffestw_set_ifthen_fake_else (block, 0);
-}
-
-/* ELSE IF statement.  */
-
-void
-ffeste_R804 (ffestw block, ffebld expr)
-{
-  tree temp;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  /* Since ELSEIF(expr) might require preparations for expr,
-     implement as ELSE; prepare-expr; IF (expr) THEN ...; ENDIF.  */
-
-  expand_start_else ();
-
-  ffeste_start_block_ (block);
-
-  temp = ffecom_make_tempvar ("elseif", integer_type_node,
-			      FFETARGET_charactersizeNONE, -1);
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_expr (expr);
-
-  if (ffecom_prepare_end ())
-    {
-      tree result;
-
-      result = ffecom_modify (void_type_node,
-			      temp,
-			      ffecom_truth_value (ffecom_expr (expr)));
-
-      expand_expr_stmt (result);
-
-      ffeste_end_stmt_ ();
-    }
-  else
-    {
-      /* In this case, we could probably have used expand_start_elseif
-	 instead, saving the need for a fake `else' construct.  But,
-	 until it's clear that'd improve performance, it's easier this
-	 way, since we have to expand_start_else before we get to this
-	 test, given the current design.  */
-
-      ffeste_end_stmt_ ();
-
-      temp = ffecom_truth_value (ffecom_expr (expr));
-    }
-
-  expand_start_cond (temp, 0);
-
-  /* Increment number of fake `else' constructs introduced.  */
-  ffestw_set_ifthen_fake_else (block,
-			       ffestw_ifthen_fake_else (block) + 1);
-}
-
-/* ELSE statement.  */
-
-void
-ffeste_R805 (ffestw block UNUSED)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  expand_start_else ();
-}
-
-/* END IF statement.  */
-
-void
-ffeste_R806 (ffestw block)
-{
-  int i = ffestw_ifthen_fake_else (block) + 1;
-
-  ffeste_emit_line_note_ ();
-
-  for (; i; --i)
-    {
-      expand_end_cond ();
-
-      ffeste_end_block_ (block);
-    }
-}
-
-/* Logical IF statement.  */
-
-void
-ffeste_R807 (ffebld expr)
-{
-  tree temp;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_block_ (NULL);
-
-  temp = ffecom_make_tempvar ("if", integer_type_node,
-			      FFETARGET_charactersizeNONE, -1);
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_expr (expr);
-
-  if (ffecom_prepare_end ())
-    {
-      tree result;
-
-      result = ffecom_modify (void_type_node,
-			      temp,
-			      ffecom_truth_value (ffecom_expr (expr)));
-
-      expand_expr_stmt (result);
-
-      ffeste_end_stmt_ ();
-    }
-  else
-    {
-      ffeste_end_stmt_ ();
-
-      temp = ffecom_truth_value (ffecom_expr (expr));
-    }
-
-  expand_start_cond (temp, 0);
-}
-
-/* SELECT CASE statement.  */
-
-void
-ffeste_R809 (ffestw block, ffebld expr)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_block_ (block);
-
-  if ((expr == NULL)
-      || (ffeinfo_basictype (ffebld_info (expr))
-	  == FFEINFO_basictypeANY))
-    ffestw_set_select_texpr (block, error_mark_node);
-  else if (ffeinfo_basictype (ffebld_info (expr))
-	   == FFEINFO_basictypeCHARACTER)
-    {
-      /* ~~~Someday handle CHARACTER*1, CHARACTER*N */
-
-      /* xgettext:no-c-format */
-      ffebad_start_msg ("SELECT CASE on CHARACTER type (at %0) not supported -- sorry",
-			FFEBAD_severityFATAL);
-      ffebad_here (0, ffestw_line (block), ffestw_col (block));
-      ffebad_finish ();
-      ffestw_set_select_texpr (block, error_mark_node);
-    }
-  else
-    {
-      tree result;
-      tree texpr;
-
-      result = ffecom_make_tempvar ("select", ffecom_type_expr (expr),
-				    ffeinfo_size (ffebld_info (expr)),
-				    -1);
-
-      ffeste_start_stmt_ ();
-
-      ffecom_prepare_expr (expr);
-
-      ffecom_prepare_end ();
-
-      texpr = ffecom_expr (expr);
-
-      assert (TYPE_MAIN_VARIANT (TREE_TYPE (texpr))
-	      == TYPE_MAIN_VARIANT (TREE_TYPE (result)));
-
-      texpr = ffecom_modify (void_type_node,
-			     result,
-			     texpr);
-      expand_expr_stmt (texpr);
-
-      ffeste_end_stmt_ ();
-
-      expand_start_case (1, result, TREE_TYPE (result),
-			 "SELECT CASE statement");
-      ffestw_set_select_texpr (block, texpr);
-      ffestw_set_select_break (block, FALSE);
-    }
-}
-
-/* CASE statement.
-
-   If casenum is 0, it's CASE DEFAULT.	Else it's the case ranges at
-   the start of the first_stmt list in the select object at the top of
-   the stack that match casenum.  */
-
-void
-ffeste_R810 (ffestw block, unsigned long casenum)
-{
-  ffestwSelect s = ffestw_select (block);
-  ffestwCase c;
-  tree texprlow;
-  tree texprhigh;
-  tree tlabel;
-  int pushok;
-  tree duplicate;
-
-  ffeste_check_simple_ ();
-
-  if (s->first_stmt == (ffestwCase) &s->first_rel)
-    c = NULL;
-  else
-    c = s->first_stmt;
-
-  ffeste_emit_line_note_ ();
-
-  if (ffestw_select_texpr (block) == error_mark_node)
-    return;
-
-  /* ~~~Someday handle CHARACTER*1, CHARACTER*N */
-
-  tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
-
-  if (ffestw_select_break (block))
-    expand_exit_something ();
-  else
-    ffestw_set_select_break (block, TRUE);
-
-  if ((c == NULL) || (casenum != c->casenum))
-    {
-      if (casenum == 0)	/* Intentional CASE DEFAULT. */
-	{
-	  pushok = pushcase (NULL_TREE, 0, tlabel, &duplicate);
-	  assert (pushok == 0);
-	}
-    }
-  else
-    do
-      {
-	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);
-	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);
-	    pushok = pushcase_range (texprlow, texprhigh, convert,
-				     tlabel, &duplicate);
-	  }
-	else
-	  pushok = pushcase (texprlow, convert, tlabel, &duplicate);
-	if (pushok == 2)
-	  {
-	    ffebad_start_msg ("SELECT (at %0) has duplicate cases -- check integer overflow of CASE(s)",
-	      FFEBAD_severityFATAL);
-	    ffebad_here (0, ffestw_line (block), ffestw_col (block));
-	    ffebad_finish ();
-	    ffestw_set_select_texpr (block, error_mark_node);
-	  }
-	c = c->next_stmt;
-	/* Unlink prev.  */
-	c->previous_stmt->previous_stmt->next_stmt = c;
-	c->previous_stmt = c->previous_stmt->previous_stmt;
-      }
-    while ((c != (ffestwCase) &s->first_rel) && (casenum == c->casenum));
-}
-
-/* END SELECT statement.  */
-
-void
-ffeste_R811 (ffestw block)
-{
-  ffeste_emit_line_note_ ();
-
-  /* ~~~Someday handle CHARACTER*1, CHARACTER*N */
-
-  if (TREE_CODE (ffestw_select_texpr (block)) != ERROR_MARK)
-    expand_end_case (ffestw_select_texpr (block));
-
-  ffeste_end_block_ (block);
-}
-
-/* Iterative DO statement.  */
-
-void
-ffeste_R819A (ffestw block, ffelab label UNUSED, ffebld var,
-	      ffebld start, ffelexToken start_token,
-	      ffebld end, ffelexToken end_token,
-	      ffebld incr, ffelexToken incr_token)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_begin_iterdo_ (block, NULL, NULL, NULL,
-			var,
-			start, start_token,
-			end, end_token,
-			incr, incr_token,
-			"Iterative DO loop");
-}
-
-/* DO WHILE statement.  */
-
-void
-ffeste_R819B (ffestw block, ffelab label UNUSED, ffebld expr)
-{
-  tree result;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_block_ (block);
-
-  if (expr)
-    {
-      struct nesting *loop;
-      tree mod;
-
-      result = ffecom_make_tempvar ("dowhile", integer_type_node,
-				    FFETARGET_charactersizeNONE, -1);
-      loop = expand_start_loop (1);
-
-      ffeste_start_stmt_ ();
-
-      ffecom_prepare_expr (expr);
-
-      ffecom_prepare_end ();
-
-      mod = ffecom_modify (void_type_node,
-			   result,
-			   ffecom_truth_value (ffecom_expr (expr)));
-      expand_expr_stmt (mod);
-
-      ffeste_end_stmt_ ();
-
-      ffestw_set_do_hook (block, loop);
-      expand_exit_loop_top_cond (0, result);
-    }
-  else
-    ffestw_set_do_hook (block, expand_start_loop (1));
-
-  ffestw_set_do_tvar (block, NULL_TREE);
-}
-
-/* END DO statement.
-
-   This is the MIL-STD 1753 END DO. It's syntactic sugar, similar to
-   CONTINUE (except that it has to have a label that is the target of
-   one or more iterative DO statement), not the Fortran-90 structured
-   END DO, which is handled elsewhere, as is the actual mechanism of
-   ending an iterative DO statement, even one that ends at a label.  */
-
-void
-ffeste_R825 (void)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  emit_nop ();
-}
-
-/* CYCLE statement.  */
-
-void
-ffeste_R834 (ffestw block)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  expand_continue_loop (ffestw_do_hook (block));
-}
-
-/* EXIT statement.  */
-
-void
-ffeste_R835 (ffestw block)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  expand_exit_loop (ffestw_do_hook (block));
-}
-
-/* GOTO statement.  */
-
-void
-ffeste_R836 (ffelab label)
-{
-  tree glabel;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  glabel = ffecom_lookup_label (label);
-  if ((glabel != NULL_TREE)
-      && (TREE_CODE (glabel) != ERROR_MARK))
-    {
-      expand_goto (glabel);
-      TREE_USED (glabel) = 1;
-    }
-}
-
-/* Computed GOTO statement.  */
-
-void
-ffeste_R837 (ffelab *labels, int count, ffebld expr)
-{
-  int i;
-  tree texpr;
-  tree value;
-  tree tlabel;
-  int pushok;
-  tree duplicate;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_expr (expr);
-
-  ffecom_prepare_end ();
-
-  texpr = ffecom_expr (expr);
-
-  expand_start_case (0, texpr, TREE_TYPE (texpr), "computed GOTO statement");
-
-  for (i = 0; i < count; ++i)
-    {
-      value = build_int_2 (i + 1, 0);
-      tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
-
-      pushok = pushcase (value, convert, tlabel, &duplicate);
-      assert (pushok == 0);
-
-      tlabel = ffecom_lookup_label (labels[i]);
-      if ((tlabel == NULL_TREE)
-	  || (TREE_CODE (tlabel) == ERROR_MARK))
-	continue;
-
-      expand_goto (tlabel);
-      TREE_USED (tlabel) = 1;
-    }
-  expand_end_case (texpr);
-
-  ffeste_end_stmt_ ();
-}
-
-/* ASSIGN statement.  */
-
-void
-ffeste_R838 (ffelab label, ffebld target)
-{
-  tree expr_tree;
-  tree label_tree;
-  tree target_tree;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-    /* No need to call ffeste_start_stmt_(), as the sorts of expressions
-       seen here should never require use of temporaries.  */
-
-  label_tree = ffecom_lookup_label (label);
-  if ((label_tree != NULL_TREE)
-      && (TREE_CODE (label_tree) != ERROR_MARK))
-    {
-      label_tree = ffecom_1 (ADDR_EXPR,
-			     build_pointer_type (void_type_node),
-			     label_tree);
-      TREE_CONSTANT (label_tree) = 1;
-
-      target_tree = ffecom_expr_assign_w (target);
-      if (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);
-
-        expr_tree = ffecom_modify (void_type_node,
-				 target_tree,
-				 label_tree);
-        expand_expr_stmt (expr_tree);
-      }
-    }
-}
-
-/* Assigned GOTO statement.  */
-
-void
-ffeste_R839 (ffebld target)
-{
-  tree t;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  /* No need to call ffeste_start_stmt_(), as the sorts of expressions
-     seen here should never require use of temporaries.  */
-
-  t = ffecom_expr_assign (target);
-
-  if (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.  */
-
-void
-ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos)
-{
-  tree gneg = ffecom_lookup_label (neg);
-  tree gzero = ffecom_lookup_label (zero);
-  tree gpos = ffecom_lookup_label (pos);
-  tree texpr;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  if ((gneg == NULL_TREE) || (gzero == NULL_TREE) || (gpos == NULL_TREE))
-    return;
-  if ((TREE_CODE (gneg) == ERROR_MARK)
-      || (TREE_CODE (gzero) == ERROR_MARK)
-      || (TREE_CODE (gpos) == ERROR_MARK))
-    return;
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_expr (expr);
-
-  ffecom_prepare_end ();
-
-  if (neg == zero)
-    {
-      if (neg == pos)
-	expand_goto (gzero);
-      else
-	{
-	  /* IF (expr.LE.0) THEN GOTO neg/zero ELSE GOTO pos.  */
-	  texpr = ffecom_expr (expr);
-	  texpr = ffecom_2 (LE_EXPR, integer_type_node,
-			    texpr,
-			    convert (TREE_TYPE (texpr),
-				     integer_zero_node));
-	  expand_start_cond (ffecom_truth_value (texpr), 0);
-	  expand_goto (gzero);
-	  expand_start_else ();
-	  expand_goto (gpos);
-	  expand_end_cond ();
-	}
-    }
-  else if (neg == pos)
-    {
-      /* IF (expr.NE.0) THEN GOTO neg/pos ELSE GOTO zero.  */
-      texpr = ffecom_expr (expr);
-      texpr = ffecom_2 (NE_EXPR, integer_type_node,
-			texpr,
-			convert (TREE_TYPE (texpr),
-				 integer_zero_node));
-      expand_start_cond (ffecom_truth_value (texpr), 0);
-      expand_goto (gneg);
-      expand_start_else ();
-      expand_goto (gzero);
-      expand_end_cond ();
-    }
-  else if (zero == pos)
-    {
-      /* IF (expr.GE.0) THEN GOTO zero/pos ELSE GOTO neg.  */
-      texpr = ffecom_expr (expr);
-      texpr = ffecom_2 (GE_EXPR, integer_type_node,
-			texpr,
-			convert (TREE_TYPE (texpr),
-				 integer_zero_node));
-      expand_start_cond (ffecom_truth_value (texpr), 0);
-      expand_goto (gzero);
-      expand_start_else ();
-      expand_goto (gneg);
-      expand_end_cond ();
-    }
-  else
-    {
-      /* Use a SAVE_EXPR in combo with:
-	 IF (expr.LT.0) THEN GOTO neg
-	 ELSEIF (expr.GT.0) THEN GOTO pos
-	 ELSE GOTO zero.  */
-      tree expr_saved = ffecom_save_tree (ffecom_expr (expr));
-
-      texpr = ffecom_2 (LT_EXPR, integer_type_node,
-			expr_saved,
-			convert (TREE_TYPE (expr_saved),
-				 integer_zero_node));
-      expand_start_cond (ffecom_truth_value (texpr), 0);
-      expand_goto (gneg);
-      texpr = ffecom_2 (GT_EXPR, integer_type_node,
-			expr_saved,
-			convert (TREE_TYPE (expr_saved),
-				 integer_zero_node));
-      expand_start_elseif (ffecom_truth_value (texpr));
-      expand_goto (gpos);
-      expand_start_else ();
-      expand_goto (gzero);
-      expand_end_cond ();
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* CONTINUE statement.  */
-
-void
-ffeste_R841 (void)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  emit_nop ();
-}
-
-/* STOP statement.  */
-
-void
-ffeste_R842 (ffebld expr)
-{
-  tree callit;
-  ffelexToken msg;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  if ((expr == NULL)
-      || (ffeinfo_basictype (ffebld_info (expr))
-	  == FFEINFO_basictypeANY))
-    {
-      msg = ffelex_token_new_character ("",
-					ffelex_token_where_line (ffesta_tokens[0]),
-					ffelex_token_where_column (ffesta_tokens[0]));
-      expr = ffebld_new_conter (ffebld_constant_new_characterdefault
-				(msg));
-      ffelex_token_kill (msg);
-      ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
-					  FFEINFO_kindtypeCHARACTERDEFAULT,
-					  0, FFEINFO_kindENTITY,
-					  FFEINFO_whereCONSTANT, 0));
-    }
-  else if (ffeinfo_basictype (ffebld_info (expr))
-	   == FFEINFO_basictypeINTEGER)
-    {
-      char num[50];
-
-      assert (ffebld_op (expr) == FFEBLD_opCONTER);
-      assert (ffeinfo_kindtype (ffebld_info (expr))
-	      == FFEINFO_kindtypeINTEGERDEFAULT);
-      sprintf (num, "%" ffetargetIntegerDefault_f "d",
-	       ffebld_constant_integer1 (ffebld_conter (expr)));
-      msg = ffelex_token_new_character (num,
-					ffelex_token_where_line (ffesta_tokens[0]),
-					ffelex_token_where_column (ffesta_tokens[0]));
-      expr = ffebld_new_conter (ffebld_constant_new_characterdefault (msg));
-      ffelex_token_kill (msg);
-      ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
-					  FFEINFO_kindtypeCHARACTERDEFAULT,
-					  0, FFEINFO_kindENTITY,
-					  FFEINFO_whereCONSTANT, 0));
-    }
-  else
-    {
-      assert (ffeinfo_basictype (ffebld_info (expr))
-	      == FFEINFO_basictypeCHARACTER);
-      assert (ffebld_op (expr) == FFEBLD_opCONTER);
-      assert (ffeinfo_kindtype (ffebld_info (expr))
-	      == FFEINFO_kindtypeCHARACTERDEFAULT);
-    }
-
-  /* No need to call ffeste_start_stmt_(), as the sorts of expressions
-     seen here should never require use of temporaries.  */
-
-  callit = ffecom_call_gfrt (FFECOM_gfrtSTOP,
-			     ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)),
-			     NULL_TREE);
-  TREE_SIDE_EFFECTS (callit) = 1;
-
-  expand_expr_stmt (callit);
-}
-
-/* PAUSE statement.  */
-
-void
-ffeste_R843 (ffebld expr)
-{
-  tree callit;
-  ffelexToken msg;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  if ((expr == NULL)
-      || (ffeinfo_basictype (ffebld_info (expr))
-	  == FFEINFO_basictypeANY))
-    {
-      msg = ffelex_token_new_character ("",
-					ffelex_token_where_line (ffesta_tokens[0]),
-					ffelex_token_where_column (ffesta_tokens[0]));
-      expr = ffebld_new_conter (ffebld_constant_new_characterdefault (msg));
-      ffelex_token_kill (msg);
-      ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
-					  FFEINFO_kindtypeCHARACTERDEFAULT,
-					  0, FFEINFO_kindENTITY,
-					  FFEINFO_whereCONSTANT, 0));
-    }
-  else if (ffeinfo_basictype (ffebld_info (expr)) == FFEINFO_basictypeINTEGER)
-    {
-      char num[50];
-
-      assert (ffebld_op (expr) == FFEBLD_opCONTER);
-      assert (ffeinfo_kindtype (ffebld_info (expr))
-	      == FFEINFO_kindtypeINTEGERDEFAULT);
-      sprintf (num, "%" ffetargetIntegerDefault_f "d",
-	       ffebld_constant_integer1 (ffebld_conter (expr)));
-      msg = ffelex_token_new_character (num, ffelex_token_where_line (ffesta_tokens[0]),
-					ffelex_token_where_column (ffesta_tokens[0]));
-      expr = ffebld_new_conter (ffebld_constant_new_characterdefault (msg));
-      ffelex_token_kill (msg);
-      ffebld_set_info (expr, ffeinfo_new (FFEINFO_basictypeCHARACTER,
-					  FFEINFO_kindtypeCHARACTERDEFAULT,
-					  0, FFEINFO_kindENTITY,
-					  FFEINFO_whereCONSTANT, 0));
-    }
-  else
-    {
-      assert (ffeinfo_basictype (ffebld_info (expr))
-	      == FFEINFO_basictypeCHARACTER);
-      assert (ffebld_op (expr) == FFEBLD_opCONTER);
-      assert (ffeinfo_kindtype (ffebld_info (expr))
-	      == FFEINFO_kindtypeCHARACTERDEFAULT);
-    }
-
-  /* No need to call ffeste_start_stmt_(), as the sorts of expressions
-     seen here should never require use of temporaries.  */
-
-  callit = ffecom_call_gfrt (FFECOM_gfrtPAUSE,
-			     ffecom_list_ptr_to_expr (ffebld_new_item (expr, NULL)),
-			     NULL_TREE);
-  TREE_SIDE_EFFECTS (callit) = 1;
-
-  expand_expr_stmt (callit);
-}
-
-/* OPEN statement.  */
-
-void
-ffeste_R904 (ffestpOpenStmt *info)
-{
-  tree args;
-  bool iostat;
-  bool errl;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-#define specified(something) (info->open_spec[something].kw_or_val_present)
-
-  iostat = specified (FFESTP_openixIOSTAT);
-  errl = specified (FFESTP_openixERR);
-
-#undef specified
-
-  ffeste_start_stmt_ ();
-
-  if (errl)
-    {
-      ffeste_io_err_
-	= ffeste_io_abort_
-	= ffecom_lookup_label
-	(info->open_spec[FFESTP_openixERR].u.label);
-      ffeste_io_abort_is_temp_ = FALSE;
-    }
-  else
-    {
-      ffeste_io_err_ = NULL_TREE;
-
-      if ((ffeste_io_abort_is_temp_ = iostat))
-	ffeste_io_abort_ = ffecom_temp_label ();
-      else
-	ffeste_io_abort_ = NULL_TREE;
-    }
-
-  if (iostat)
-    {
-      /* Have IOSTAT= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = ffecom_expr
-	(info->open_spec[FFESTP_openixIOSTAT].u.expr);
-    }
-  else if (ffeste_io_abort_ != NULL_TREE)
-    {
-      /* Have no IOSTAT= but have ERR=.  */
-
-      ffeste_io_iostat_is_temp_ = TRUE;
-      ffeste_io_iostat_
-	= ffecom_make_tempvar ("open", ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1);
-    }
-  else
-    {
-      /* No IOSTAT= or ERR= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = NULL_TREE;
-    }
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  args = ffeste_io_olist_ (errl || iostat,
-			   info->open_spec[FFESTP_openixUNIT].u.expr,
-			   &info->open_spec[FFESTP_openixFILE],
-			   &info->open_spec[FFESTP_openixSTATUS],
-			   &info->open_spec[FFESTP_openixACCESS],
-			   &info->open_spec[FFESTP_openixFORM],
-			   &info->open_spec[FFESTP_openixRECL],
-			   &info->open_spec[FFESTP_openixBLANK]);
-
-  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
-       label, since we're gonna fall through to there anyway. */
-
-  ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFOPEN, args, NULL_TREE),
-		   ! ffeste_io_abort_is_temp_);
-
-  /* If we've got a temp label, generate its code here.  */
-
-  if (ffeste_io_abort_is_temp_)
-    {
-      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-      emit_nop ();
-      expand_label (ffeste_io_abort_);
-
-      assert (ffeste_io_err_ == NULL_TREE);
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* CLOSE statement.  */
-
-void
-ffeste_R907 (ffestpCloseStmt *info)
-{
-  tree args;
-  bool iostat;
-  bool errl;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-#define specified(something) (info->close_spec[something].kw_or_val_present)
-
-  iostat = specified (FFESTP_closeixIOSTAT);
-  errl = specified (FFESTP_closeixERR);
-
-#undef specified
-
-  ffeste_start_stmt_ ();
-
-  if (errl)
-    {
-      ffeste_io_err_
-	= ffeste_io_abort_
-	= ffecom_lookup_label
-	(info->close_spec[FFESTP_closeixERR].u.label);
-      ffeste_io_abort_is_temp_ = FALSE;
-    }
-  else
-    {
-      ffeste_io_err_ = NULL_TREE;
-
-      if ((ffeste_io_abort_is_temp_ = iostat))
-	ffeste_io_abort_ = ffecom_temp_label ();
-      else
-	ffeste_io_abort_ = NULL_TREE;
-    }
-
-  if (iostat)
-    {
-      /* Have IOSTAT= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = ffecom_expr
-	(info->close_spec[FFESTP_closeixIOSTAT].u.expr);
-    }
-  else if (ffeste_io_abort_ != NULL_TREE)
-    {
-      /* Have no IOSTAT= but have ERR=.  */
-
-      ffeste_io_iostat_is_temp_ = TRUE;
-      ffeste_io_iostat_
-	= ffecom_make_tempvar ("close", ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1);
-    }
-  else
-    {
-      /* No IOSTAT= or ERR= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = NULL_TREE;
-    }
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  args = ffeste_io_cllist_ (errl || iostat,
-			    info->close_spec[FFESTP_closeixUNIT].u.expr,
-			    &info->close_spec[FFESTP_closeixSTATUS]);
-
-  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
-       label, since we're gonna fall through to there anyway. */
-
-  ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFCLOS, args, NULL_TREE),
-		   ! ffeste_io_abort_is_temp_);
-
-  /* If we've got a temp label, generate its code here. */
-
-  if (ffeste_io_abort_is_temp_)
-    {
-      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-      emit_nop ();
-      expand_label (ffeste_io_abort_);
-
-      assert (ffeste_io_err_ == NULL_TREE);
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* READ(...) statement -- start.  */
-
-void
-ffeste_R909_start (ffestpReadStmt *info, bool only_format UNUSED,
-		   ffestvUnit unit, ffestvFormat format, bool rec,
-		   bool key UNUSED)
-{
-  ffecomGfrt start;
-  ffecomGfrt end;
-  tree cilist;
-  bool iostat;
-  bool errl;
-  bool endl;
-
-  ffeste_check_start_ ();
-
-  ffeste_emit_line_note_ ();
-
-  /* First determine the start, per-item, and end run-time functions to
-     call.  The per-item function is picked by choosing an ffeste function
-     to call to handle a given item; it knows how to generate a call to the
-     appropriate run-time function, and is called an "I/O driver".  */
-
-  switch (format)
-    {
-    case FFESTV_formatNONE:	/* no FMT= */
-      ffeste_io_driver_ = ffeste_io_douio_;
-      if (rec)
-	start = FFECOM_gfrtSRDUE, end = FFECOM_gfrtERDUE;
-      else
-	start = FFECOM_gfrtSRSUE, end = FFECOM_gfrtERSUE;
-      break;
-
-    case FFESTV_formatLABEL:	/* FMT=10 */
-    case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
-    case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
-      ffeste_io_driver_ = ffeste_io_dofio_;
-      if (rec)
-	start = FFECOM_gfrtSRDFE, end = FFECOM_gfrtERDFE;
-      else if (unit == FFESTV_unitCHAREXPR)
-	start = FFECOM_gfrtSRSFI, end = FFECOM_gfrtERSFI;
-      else
-	start = FFECOM_gfrtSRSFE, end = FFECOM_gfrtERSFE;
-      break;
-
-    case FFESTV_formatASTERISK:	/* FMT=* */
-      ffeste_io_driver_ = ffeste_io_dolio_;
-      if (unit == FFESTV_unitCHAREXPR)
-	start = FFECOM_gfrtSRSLI, end = FFECOM_gfrtERSLI;
-      else
-	start = FFECOM_gfrtSRSLE, end = FFECOM_gfrtERSLE;
-      break;
-
-    case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
-				   /FOO/] */
-      ffeste_io_driver_ = NULL;	/* No start or driver function. */
-      start = FFECOM_gfrtSRSNE, end = FFECOM_gfrt;
-      break;
-
-    default:
-      assert ("Weird stuff" == NULL);
-      start = FFECOM_gfrt, end = FFECOM_gfrt;
-      break;
-    }
-  ffeste_io_endgfrt_ = end;
-
-#define specified(something) (info->read_spec[something].kw_or_val_present)
-
-  iostat = specified (FFESTP_readixIOSTAT);
-  errl = specified (FFESTP_readixERR);
-  endl = specified (FFESTP_readixEND);
-
-#undef specified
-
-  ffeste_start_stmt_ ();
-
-  if (errl)
-    {
-      /* Have ERR= specification.   */
-
-      ffeste_io_err_
-	= ffecom_lookup_label (info->read_spec[FFESTP_readixERR].u.label);
-
-      if (endl)
-	{
-	  /* Have both ERR= and END=.  Need a temp label to handle both.  */
-	  ffeste_io_end_
-	    = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label);
-	  ffeste_io_abort_is_temp_ = TRUE;
-	  ffeste_io_abort_ = ffecom_temp_label ();
-	}
-      else
-	{
-	  /* Have ERR= but no END=.  */
-	  ffeste_io_end_ = NULL_TREE;
-	  if ((ffeste_io_abort_is_temp_ = iostat))
-	    ffeste_io_abort_ = ffecom_temp_label ();
-	  else
-	    ffeste_io_abort_ = ffeste_io_err_;
-	}
-    }
-  else
-    {
-      /* No ERR= specification.  */
-
-      ffeste_io_err_ = NULL_TREE;
-      if (endl)
-	{
-	  /* Have END= but no ERR=.  */
-	  ffeste_io_end_
-	    = ffecom_lookup_label (info->read_spec[FFESTP_readixEND].u.label);
-	  if ((ffeste_io_abort_is_temp_ = iostat))
-	    ffeste_io_abort_ = ffecom_temp_label ();
-	  else
-	    ffeste_io_abort_ = ffeste_io_end_;
-	}
-      else
-	{
-	  /* Have no ERR= or END=.  */
-
-	  ffeste_io_end_ = NULL_TREE;
-	  if ((ffeste_io_abort_is_temp_ = iostat))
-	    ffeste_io_abort_ = ffecom_temp_label ();
-	  else
-	    ffeste_io_abort_ = NULL_TREE;
-	}
-    }
-
-  if (iostat)
-    {
-      /* Have IOSTAT= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_
-	= ffecom_expr (info->read_spec[FFESTP_readixIOSTAT].u.expr);
-    }
-  else if (ffeste_io_abort_ != NULL_TREE)
-    {
-      /* Have no IOSTAT= but have ERR= and/or END=.  */
-
-      ffeste_io_iostat_is_temp_ = TRUE;
-      ffeste_io_iostat_
-	= ffecom_make_tempvar ("read", ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1);
-    }
-  else
-    {
-      /* No IOSTAT=, ERR=, or END= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = NULL_TREE;
-    }
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  if (unit == FFESTV_unitCHAREXPR)
-    cilist = ffeste_io_icilist_ (errl || iostat,
-				 info->read_spec[FFESTP_readixUNIT].u.expr,
-				 endl || iostat, format,
-				 &info->read_spec[FFESTP_readixFORMAT]);
-  else
-    cilist = ffeste_io_cilist_ (errl || iostat, unit,
-				info->read_spec[FFESTP_readixUNIT].u.expr,
-				5, endl || iostat, format,
-				&info->read_spec[FFESTP_readixFORMAT],
-				rec,
-				info->read_spec[FFESTP_readixREC].u.expr);
-
-  /* If there is no end function, then there are no item functions (i.e.
-     it's a NAMELIST), and vice versa by the way.  In this situation, don't
-     generate the "if (iostat != 0) goto label;" if the label is temp abort
-     label, since we're gonna fall through to there anyway.  */
-
-  ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE),
-		   (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt));
-}
-
-/* READ statement -- I/O item.  */
-
-void
-ffeste_R909_item (ffebld expr, ffelexToken expr_token)
-{
-  ffeste_check_item_ ();
-
-  if (expr == NULL)
-    return;
-
-  /* Strip parens off items such as in "READ *,(A)".  This is really a bug
-     in the user's code, but I've been told lots of code does this.  */
-  while (ffebld_op (expr) == FFEBLD_opPAREN)
-    expr = ffebld_left (expr);
-
-  if (ffebld_op (expr) == FFEBLD_opANY)
-    return;
-
-  if (ffebld_op (expr) == FFEBLD_opIMPDO)
-    ffeste_io_impdo_ (expr, expr_token);
-  else
-    {
-      ffeste_start_stmt_ ();
-
-      ffecom_prepare_arg_ptr_to_expr (expr);
-
-      ffecom_prepare_end ();
-
-      ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
-
-      ffeste_end_stmt_ ();
-    }
-}
-
-/* READ statement -- end.  */
-
-void
-ffeste_R909_finish (void)
-{
-  ffeste_check_finish_ ();
-
-  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
-     label, since we're gonna fall through to there anyway. */
-
-  if (ffeste_io_endgfrt_ != FFECOM_gfrt)
-    ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE,
-				       NULL_TREE),
-		     ! ffeste_io_abort_is_temp_);
-
-  /* If we've got a temp label, generate its code here and have it fan out
-     to the END= or ERR= label as appropriate. */
-
-  if (ffeste_io_abort_is_temp_)
-    {
-      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-      emit_nop ();
-      expand_label (ffeste_io_abort_);
-
-      /* "if (iostat<0) goto end_label;".  */
-
-      if ((ffeste_io_end_ != NULL_TREE)
-	  && (TREE_CODE (ffeste_io_end_) != ERROR_MARK))
-	{
-	  expand_start_cond (ffecom_truth_value
-			     (ffecom_2 (LT_EXPR, integer_type_node,
-					ffeste_io_iostat_,
-					ffecom_integer_zero_node)),
-			     0);
-	  expand_goto (ffeste_io_end_);
-	  expand_end_cond ();
-	}
-
-      /* "if (iostat>0) goto err_label;".  */
-
-      if ((ffeste_io_err_ != NULL_TREE)
-	  && (TREE_CODE (ffeste_io_err_) != ERROR_MARK))
-	{
-	  expand_start_cond (ffecom_truth_value
-			     (ffecom_2 (GT_EXPR, integer_type_node,
-					ffeste_io_iostat_,
-					ffecom_integer_zero_node)),
-			     0);
-	  expand_goto (ffeste_io_err_);
-	  expand_end_cond ();
-	}
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* WRITE statement -- start.  */
-
-void
-ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
-		   ffestvFormat format, bool rec)
-{
-  ffecomGfrt start;
-  ffecomGfrt end;
-  tree cilist;
-  bool iostat;
-  bool errl;
-
-  ffeste_check_start_ ();
-
-  ffeste_emit_line_note_ ();
-
-  /* First determine the start, per-item, and end run-time functions to
-     call.  The per-item function is picked by choosing an ffeste function
-     to call to handle a given item; it knows how to generate a call to the
-     appropriate run-time function, and is called an "I/O driver".  */
-
-  switch (format)
-    {
-    case FFESTV_formatNONE:	/* no FMT= */
-      ffeste_io_driver_ = ffeste_io_douio_;
-      if (rec)
-	start = FFECOM_gfrtSWDUE, end = FFECOM_gfrtEWDUE;
-      else
-	start = FFECOM_gfrtSWSUE, end = FFECOM_gfrtEWSUE;
-      break;
-
-    case FFESTV_formatLABEL:	/* FMT=10 */
-    case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
-    case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
-      ffeste_io_driver_ = ffeste_io_dofio_;
-      if (rec)
-	start = FFECOM_gfrtSWDFE, end = FFECOM_gfrtEWDFE;
-      else if (unit == FFESTV_unitCHAREXPR)
-	start = FFECOM_gfrtSWSFI, end = FFECOM_gfrtEWSFI;
-      else
-	start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE;
-      break;
-
-    case FFESTV_formatASTERISK:	/* FMT=* */
-      ffeste_io_driver_ = ffeste_io_dolio_;
-      if (unit == FFESTV_unitCHAREXPR)
-	start = FFECOM_gfrtSWSLI, end = FFECOM_gfrtEWSLI;
-      else
-	start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE;
-      break;
-
-    case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
-				   /FOO/] */
-      ffeste_io_driver_ = NULL;	/* No start or driver function. */
-      start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt;
-      break;
-
-    default:
-      assert ("Weird stuff" == NULL);
-      start = FFECOM_gfrt, end = FFECOM_gfrt;
-      break;
-    }
-  ffeste_io_endgfrt_ = end;
-
-#define specified(something) (info->write_spec[something].kw_or_val_present)
-
-  iostat = specified (FFESTP_writeixIOSTAT);
-  errl = specified (FFESTP_writeixERR);
-
-#undef specified
-
-  ffeste_start_stmt_ ();
-
-  ffeste_io_end_ = NULL_TREE;
-
-  if (errl)
-    {
-      /* Have ERR= specification.   */
-
-      ffeste_io_err_
-	= ffeste_io_abort_
-	= ffecom_lookup_label
-	(info->write_spec[FFESTP_writeixERR].u.label);
-      ffeste_io_abort_is_temp_ = FALSE;
-    }
-  else
-    {
-      /* No ERR= specification.  */
-
-      ffeste_io_err_ = NULL_TREE;
-
-      if ((ffeste_io_abort_is_temp_ = iostat))
-	ffeste_io_abort_ = ffecom_temp_label ();
-      else
-	ffeste_io_abort_ = NULL_TREE;
-    }
-
-  if (iostat)
-    {
-      /* Have IOSTAT= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = ffecom_expr
-	(info->write_spec[FFESTP_writeixIOSTAT].u.expr);
-    }
-  else if (ffeste_io_abort_ != NULL_TREE)
-    {
-      /* Have no IOSTAT= but have ERR=.  */
-
-      ffeste_io_iostat_is_temp_ = TRUE;
-      ffeste_io_iostat_
-	= ffecom_make_tempvar ("write", ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1);
-    }
-  else
-    {
-      /* No IOSTAT= or ERR= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = NULL_TREE;
-    }
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  if (unit == FFESTV_unitCHAREXPR)
-    cilist = ffeste_io_icilist_ (errl || iostat,
-				 info->write_spec[FFESTP_writeixUNIT].u.expr,
-				 FALSE, format,
-				 &info->write_spec[FFESTP_writeixFORMAT]);
-  else
-    cilist = ffeste_io_cilist_ (errl || iostat, unit,
-				info->write_spec[FFESTP_writeixUNIT].u.expr,
-				6, FALSE, format,
-				&info->write_spec[FFESTP_writeixFORMAT],
-				rec,
-				info->write_spec[FFESTP_writeixREC].u.expr);
-
-  /* If there is no end function, then there are no item functions (i.e.
-     it's a NAMELIST), and vice versa by the way.  In this situation, don't
-     generate the "if (iostat != 0) goto label;" if the label is temp abort
-     label, since we're gonna fall through to there anyway.  */
-
-  ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE),
-		   (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt));
-}
-
-/* WRITE statement -- I/O item.  */
-
-void
-ffeste_R910_item (ffebld expr, ffelexToken expr_token)
-{
-  ffeste_check_item_ ();
-
-  if (expr == NULL)
-    return;
-
-  if (ffebld_op (expr) == FFEBLD_opANY)
-    return;
-
-  if (ffebld_op (expr) == FFEBLD_opIMPDO)
-    ffeste_io_impdo_ (expr, expr_token);
-  else
-    {
-      ffeste_start_stmt_ ();
-
-      ffecom_prepare_arg_ptr_to_expr (expr);
-
-      ffecom_prepare_end ();
-
-      ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
-
-      ffeste_end_stmt_ ();
-    }
-}
-
-/* WRITE statement -- end.  */
-
-void
-ffeste_R910_finish (void)
-{
-  ffeste_check_finish_ ();
-
-  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
-     label, since we're gonna fall through to there anyway. */
-
-  if (ffeste_io_endgfrt_ != FFECOM_gfrt)
-    ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE,
-				       NULL_TREE),
-		     ! ffeste_io_abort_is_temp_);
-
-  /* If we've got a temp label, generate its code here. */
-
-  if (ffeste_io_abort_is_temp_)
-    {
-      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-      emit_nop ();
-      expand_label (ffeste_io_abort_);
-
-      assert (ffeste_io_err_ == NULL_TREE);
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* PRINT statement -- start.  */
-
-void
-ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format)
-{
-  ffecomGfrt start;
-  ffecomGfrt end;
-  tree cilist;
-
-  ffeste_check_start_ ();
-
-  ffeste_emit_line_note_ ();
-
-  /* First determine the start, per-item, and end run-time functions to
-     call.  The per-item function is picked by choosing an ffeste function
-     to call to handle a given item; it knows how to generate a call to the
-     appropriate run-time function, and is called an "I/O driver".  */
-
-  switch (format)
-    {
-    case FFESTV_formatLABEL:	/* FMT=10 */
-    case FFESTV_formatCHAREXPR:	/* FMT='(I10)' */
-    case FFESTV_formatINTEXPR:	/* FMT=I [after ASSIGN 10 TO I] */
-      ffeste_io_driver_ = ffeste_io_dofio_;
-      start = FFECOM_gfrtSWSFE, end = FFECOM_gfrtEWSFE;
-      break;
-
-    case FFESTV_formatASTERISK:	/* FMT=* */
-      ffeste_io_driver_ = ffeste_io_dolio_;
-      start = FFECOM_gfrtSWSLE, end = FFECOM_gfrtEWSLE;
-      break;
-
-    case FFESTV_formatNAMELIST:	/* FMT=FOO or NML=FOO [NAMELIST
-				   /FOO/] */
-      ffeste_io_driver_ = NULL;	/* No start or driver function. */
-      start = FFECOM_gfrtSWSNE, end = FFECOM_gfrt;
-      break;
-
-    default:
-      assert ("Weird stuff" == NULL);
-      start = FFECOM_gfrt, end = FFECOM_gfrt;
-      break;
-    }
-  ffeste_io_endgfrt_ = end;
-
-  ffeste_start_stmt_ ();
-
-  ffeste_io_end_ = NULL_TREE;
-  ffeste_io_err_ = NULL_TREE;
-  ffeste_io_abort_ = NULL_TREE;
-  ffeste_io_abort_is_temp_ = FALSE;
-  ffeste_io_iostat_is_temp_ = FALSE;
-  ffeste_io_iostat_ = NULL_TREE;
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  cilist = ffeste_io_cilist_ (FALSE, FFESTV_unitNONE, NULL, 6, FALSE, format,
-			      &info->print_spec[FFESTP_printixFORMAT],
-			      FALSE, NULL);
-
-  /* If there is no end function, then there are no item functions (i.e.
-     it's a NAMELIST), and vice versa by the way.  In this situation, don't
-     generate the "if (iostat != 0) goto label;" if the label is temp abort
-     label, since we're gonna fall through to there anyway.  */
-
-  ffeste_io_call_ (ffecom_call_gfrt (start, cilist, NULL_TREE),
-		   (! ffeste_io_abort_is_temp_) || (end != FFECOM_gfrt));
-}
-
-/* PRINT statement -- I/O item.  */
-
-void
-ffeste_R911_item (ffebld expr, ffelexToken expr_token)
-{
-  ffeste_check_item_ ();
-
-  if (expr == NULL)
-    return;
-
-  if (ffebld_op (expr) == FFEBLD_opANY)
-    return;
-
-  if (ffebld_op (expr) == FFEBLD_opIMPDO)
-    ffeste_io_impdo_ (expr, expr_token);
-  else
-    {
-      ffeste_start_stmt_ ();
-
-      ffecom_prepare_arg_ptr_to_expr (expr);
-
-      ffecom_prepare_end ();
-
-      ffeste_io_call_ ((*ffeste_io_driver_) (expr), TRUE);
-
-      ffeste_end_stmt_ ();
-    }
-}
-
-/* PRINT statement -- end.  */
-
-void
-ffeste_R911_finish (void)
-{
-  ffeste_check_finish_ ();
-
-  if (ffeste_io_endgfrt_ != FFECOM_gfrt)
-    ffeste_io_call_ (ffecom_call_gfrt (ffeste_io_endgfrt_, NULL_TREE,
-				       NULL_TREE),
-		     FALSE);
-
-  ffeste_end_stmt_ ();
-}
-
-/* BACKSPACE statement.  */
-
-void
-ffeste_R919 (ffestpBeruStmt *info)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_subr_beru_ (info, FFECOM_gfrtFBACK);
-}
-
-/* ENDFILE statement.  */
-
-void
-ffeste_R920 (ffestpBeruStmt *info)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_subr_beru_ (info, FFECOM_gfrtFEND);
-}
-
-/* REWIND statement.  */
-
-void
-ffeste_R921 (ffestpBeruStmt *info)
-{
-  ffeste_check_simple_ ();
-
-  ffeste_subr_beru_ (info, FFECOM_gfrtFREW);
-}
-
-/* INQUIRE statement (non-IOLENGTH version).  */
-
-void
-ffeste_R923A (ffestpInquireStmt *info, bool by_file UNUSED)
-{
-  tree args;
-  bool iostat;
-  bool errl;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-#define specified(something) (info->inquire_spec[something].kw_or_val_present)
-
-  iostat = specified (FFESTP_inquireixIOSTAT);
-  errl = specified (FFESTP_inquireixERR);
-
-#undef specified
-
-  ffeste_start_stmt_ ();
-
-  if (errl)
-    {
-      ffeste_io_err_
-	= ffeste_io_abort_
-	= ffecom_lookup_label
-	(info->inquire_spec[FFESTP_inquireixERR].u.label);
-      ffeste_io_abort_is_temp_ = FALSE;
-    }
-  else
-    {
-      ffeste_io_err_ = NULL_TREE;
-
-      if ((ffeste_io_abort_is_temp_ = iostat))
-	ffeste_io_abort_ = ffecom_temp_label ();
-      else
-	ffeste_io_abort_ = NULL_TREE;
-    }
-
-  if (iostat)
-    {
-      /* Have IOSTAT= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = ffecom_expr
-	(info->inquire_spec[FFESTP_inquireixIOSTAT].u.expr);
-    }
-  else if (ffeste_io_abort_ != NULL_TREE)
-    {
-      /* Have no IOSTAT= but have ERR=.  */
-
-      ffeste_io_iostat_is_temp_ = TRUE;
-      ffeste_io_iostat_
-	= ffecom_make_tempvar ("inquire", ffecom_integer_type_node,
-			       FFETARGET_charactersizeNONE, -1);
-    }
-  else
-    {
-      /* No IOSTAT= or ERR= specification.  */
-
-      ffeste_io_iostat_is_temp_ = FALSE;
-      ffeste_io_iostat_ = NULL_TREE;
-    }
-
-  /* Now prescan, then convert, all the arguments.  */
-
-  args
-    = ffeste_io_inlist_ (errl || iostat,
-			 &info->inquire_spec[FFESTP_inquireixUNIT],
-			 &info->inquire_spec[FFESTP_inquireixFILE],
-			 &info->inquire_spec[FFESTP_inquireixEXIST],
-			 &info->inquire_spec[FFESTP_inquireixOPENED],
-			 &info->inquire_spec[FFESTP_inquireixNUMBER],
-			 &info->inquire_spec[FFESTP_inquireixNAMED],
-			 &info->inquire_spec[FFESTP_inquireixNAME],
-			 &info->inquire_spec[FFESTP_inquireixACCESS],
-			 &info->inquire_spec[FFESTP_inquireixSEQUENTIAL],
-			 &info->inquire_spec[FFESTP_inquireixDIRECT],
-			 &info->inquire_spec[FFESTP_inquireixFORM],
-			 &info->inquire_spec[FFESTP_inquireixFORMATTED],
-			 &info->inquire_spec[FFESTP_inquireixUNFORMATTED],
-			 &info->inquire_spec[FFESTP_inquireixRECL],
-			 &info->inquire_spec[FFESTP_inquireixNEXTREC],
-			 &info->inquire_spec[FFESTP_inquireixBLANK]);
-
-  /* Don't generate "if (iostat != 0) goto label;" if label is temp abort
-     label, since we're gonna fall through to there anyway. */
-
-  ffeste_io_call_ (ffecom_call_gfrt (FFECOM_gfrtFINQU, args, NULL_TREE),
-		   ! ffeste_io_abort_is_temp_);
-
-  /* If we've got a temp label, generate its code here.  */
-
-  if (ffeste_io_abort_is_temp_)
-    {
-      DECL_INITIAL (ffeste_io_abort_) = error_mark_node;
-      emit_nop ();
-      expand_label (ffeste_io_abort_);
-
-      assert (ffeste_io_err_ == NULL_TREE);
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* INQUIRE(IOLENGTH=expr) statement -- start.  */
-
-void
-ffeste_R923B_start (ffestpInquireStmt *info UNUSED)
-{
-  ffeste_check_start_ ();
-
-  assert ("INQUIRE(IOLENGTH=<var>) not implemented yet! ~~~" == NULL);
-
-  ffeste_emit_line_note_ ();
-}
-
-/* INQUIRE(IOLENGTH=expr) statement -- I/O item.  */
-
-void
-ffeste_R923B_item (ffebld expr UNUSED)
-{
-  ffeste_check_item_ ();
-}
-
-/* INQUIRE(IOLENGTH=expr) statement -- end.  */
-
-void
-ffeste_R923B_finish (void)
-{
-  ffeste_check_finish_ ();
-}
-
-/* ffeste_R1001 -- FORMAT statement
-
-   ffeste_R1001(format_list);  */
-
-void
-ffeste_R1001 (ffests s)
-{
-  tree t;
-  tree ttype;
-  tree maxindex;
-  tree var;
-
-  ffeste_check_simple_ ();
-
-  assert (ffeste_label_formatdef_ != NULL);
-
-  ffeste_emit_line_note_ ();
-
-  t = build_string (ffests_length (s), ffests_text (s));
-
-  TREE_TYPE (t)
-    = build_type_variant (build_array_type
-			  (char_type_node,
-			   build_range_type (integer_type_node,
-					     integer_one_node,
-					     build_int_2 (ffests_length (s),
-							  0))),
-			  1, 0);
-  TREE_CONSTANT (t) = 1;
-  TREE_STATIC (t) = 1;
-
-  var = ffecom_lookup_label (ffeste_label_formatdef_);
-  if ((var != NULL_TREE)
-      && (TREE_CODE (var) == VAR_DECL))
-    {
-      DECL_INITIAL (var) = t;
-      maxindex = build_int_2 (ffests_length (s) - 1, 0);
-      ttype = TREE_TYPE (var);
-      TYPE_DOMAIN (ttype) = build_range_type (integer_type_node,
-					      integer_zero_node,
-					      maxindex);
-      if (!TREE_TYPE (maxindex))
-	TREE_TYPE (maxindex) = TYPE_DOMAIN (ttype);
-      layout_type (ttype);
-      rest_of_decl_compilation (var, NULL, 1, 0);
-      expand_decl (var);
-      expand_decl_init (var);
-    }
-
-  ffeste_label_formatdef_ = NULL;
-}
-
-/* END PROGRAM.  */
-
-void
-ffeste_R1103 (void)
-{
-}
-
-/* END BLOCK DATA.  */
-
-void
-ffeste_R1112 (void)
-{
-}
-
-/* CALL statement.  */
-
-void
-ffeste_R1212 (ffebld expr)
-{
-  ffebld args;
-  ffebld arg;
-  ffebld labels = NULL;	/* First in list of LABTERs. */
-  ffebld prevlabels = NULL;
-  ffebld prevargs = NULL;
-
-  ffeste_check_simple_ ();
-
-  args = ffebld_right (expr);
-
-  ffeste_emit_line_note_ ();
-
-  /* Here we split the list at ffebld_right(expr) into two lists: one at
-     ffebld_right(expr) consisting of all items that are not LABTERs, the
-     other at labels consisting of all items that are LABTERs.  Then, if
-     the latter list is NULL, we have an ordinary call, else we have a call
-     with alternate returns. */
-
-  for (args = ffebld_right (expr); args != NULL; args = ffebld_trail (args))
-    {
-      if (((arg = ffebld_head (args)) == NULL)
-	  || (ffebld_op (arg) != FFEBLD_opLABTER))
-	{
-	  if (prevargs == NULL)
-	    {
-	      prevargs = args;
-	      ffebld_set_right (expr, args);
-	    }
-	  else
-	    {
-	      ffebld_set_trail (prevargs, args);
-	      prevargs = args;
-	    }
-	}
-      else
-	{
-	  if (prevlabels == NULL)
-	    {
-	      prevlabels = labels = args;
-	    }
-	  else
-	    {
-	      ffebld_set_trail (prevlabels, args);
-	      prevlabels = args;
-	    }
-	}
-    }
-  if (prevlabels == NULL)
-    labels = NULL;
-  else
-    ffebld_set_trail (prevlabels, NULL);
-  if (prevargs == NULL)
-    ffebld_set_right (expr, NULL);
-  else
-    ffebld_set_trail (prevargs, NULL);
-
-  ffeste_start_stmt_ ();
-
-  /* No temporaries are actually needed at this level, but we go
-     through the motions anyway, just to be sure in case they do
-     get made.  Temporaries needed for arguments should be in the
-     scopes of inner blocks, and if clean-up actions are supported,
-     such as CALL-ing an intrinsic that writes to an argument of one
-     type when a variable of a different type is provided (requiring
-     assignment to the variable from a temporary after the library
-     routine returns), the clean-up must be done by the expression
-     evaluator, generally, to handle alternate returns (which we hope
-     won't ever be supported by intrinsics, but might be a similar
-     issue, such as CALL-ing an F90-style subroutine with an INTERFACE
-     block).  That implies the expression evaluator will have to
-     recognize the need for its own temporary anyway, meaning it'll
-     construct a block within the one constructed here.  */
-
-  ffecom_prepare_expr (expr);
-
-  ffecom_prepare_end ();
-
-  if (labels == NULL)
-    expand_expr_stmt (ffecom_expr (expr));
-  else
-    {
-      tree texpr;
-      tree value;
-      tree tlabel;
-      int caseno;
-      int pushok;
-      tree duplicate;
-      ffebld label;
-
-      texpr = ffecom_expr (expr);
-      expand_start_case (0, texpr, TREE_TYPE (texpr), "CALL statement");
-
-      for (caseno = 1, label = labels;
-	   label != NULL;
-	   ++caseno, label = ffebld_trail (label))
-	{
-	  value = build_int_2 (caseno, 0);
-	  tlabel = build_decl (LABEL_DECL, NULL_TREE, NULL_TREE);
-
-	  pushok = pushcase (value, convert, tlabel, &duplicate);
-	  assert (pushok == 0);
-
-	  tlabel
-	    = ffecom_lookup_label (ffebld_labter (ffebld_head (label)));
-	  if ((tlabel == NULL_TREE)
-	      || (TREE_CODE (tlabel) == ERROR_MARK))
-	    continue;
-	  TREE_USED (tlabel) = 1;
-	  expand_goto (tlabel);
-	}
-
-      expand_end_case (texpr);
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* END FUNCTION.  */
-
-void
-ffeste_R1221 (void)
-{
-}
-
-/* END SUBROUTINE.  */
-
-void
-ffeste_R1225 (void)
-{
-}
-
-/* ENTRY statement.  */
-
-void
-ffeste_R1226 (ffesymbol entry)
-{
-  tree label;
-
-  ffeste_check_simple_ ();
-
-  label = ffesymbol_hook (entry).length_tree;
-
-  ffeste_emit_line_note_ ();
-
-  if (label == error_mark_node)
-    return;
-
-  DECL_INITIAL (label) = error_mark_node;
-  emit_nop ();
-  expand_label (label);
-}
-
-/* RETURN statement.  */
-
-void
-ffeste_R1227 (ffestw block UNUSED, ffebld expr)
-{
-  tree rtn;
-
-  ffeste_check_simple_ ();
-
-  ffeste_emit_line_note_ ();
-
-  ffeste_start_stmt_ ();
-
-  ffecom_prepare_return_expr (expr);
-
-  ffecom_prepare_end ();
-
-  rtn = ffecom_return_expr (expr);
-
-  if ((rtn == NULL_TREE)
-      || (rtn == error_mark_node))
-    expand_null_return ();
-  else
-    {
-      tree result = DECL_RESULT (current_function_decl);
-
-      if ((result != error_mark_node)
-	  && (TREE_TYPE (result) != error_mark_node))
-	expand_return (ffecom_modify (NULL_TREE,
-				      result,
-				      convert (TREE_TYPE (result),
-					       rtn)));
-      else
-	expand_null_return ();
-    }
-
-  ffeste_end_stmt_ ();
-}
-
-/* REWRITE statement -- start.  */
-
-/* TYPE statement -- start.  */
-
-void
-ffeste_V020_start (ffestpTypeStmt *info UNUSED,
-		   ffestvFormat format UNUSED)
-{
-  ffeste_check_start_ ();
-}
-
-/* TYPE statement -- I/O item.  */
-
-void
-ffeste_V020_item (ffebld expr UNUSED)
-{
-  ffeste_check_item_ ();
-}
-
-/* TYPE statement -- end.  */
-
-void
-ffeste_V020_finish (void)
-{
-  ffeste_check_finish_ ();
-}
-
-/* DELETE statement.  */
-
-
-#ifdef ENABLE_CHECKING
-void
-ffeste_terminate_2 (void)
-{
-  assert (! ffeste_top_block_);
-}
-#endif
-
-#include "gt-f-ste.h"
diff --git a/gcc/f/ste.h b/gcc/f/ste.h
deleted file mode 100644
index ac04a4c..0000000
--- a/gcc/f/ste.h
+++ /dev/null
@@ -1,144 +0,0 @@
-/* ste.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      ste.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STE_H
-#define GCC_F_STE_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "lab.h"
-#include "lex.h"
-#include "stp.h"
-#include "str.h"
-#include "sts.h"
-#include "stt.h"
-#include "stv.h"
-#include "stw.h"
-#include "symbol.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffeste_do (ffestw block);
-void ffeste_end_R807 (void);
-void ffeste_labeldef_branch (ffelab label);
-void ffeste_labeldef_format (ffelab label);
-void ffeste_R737A (ffebld dest, ffebld source);
-void ffeste_R803 (ffestw block, ffebld expr);
-void ffeste_R804 (ffestw block, ffebld expr);
-void ffeste_R805 (ffestw block);
-void ffeste_R806 (ffestw block);
-void ffeste_R807 (ffebld expr);
-void ffeste_R809 (ffestw block, ffebld expr);
-void ffeste_R810 (ffestw block, unsigned long casenum);
-void ffeste_R811 (ffestw block);
-void ffeste_R819A (ffestw block, ffelab label, ffebld var,
-		   ffebld start, ffelexToken start_token,
-		   ffebld end, ffelexToken end_token,
-		   ffebld incr, ffelexToken incr_token);
-void ffeste_R819B (ffestw block, ffelab label, ffebld expr);
-void ffeste_R825 (void);
-void ffeste_R834 (ffestw block);
-void ffeste_R835 (ffestw block);
-void ffeste_R836 (ffelab label);
-void ffeste_R837 (ffelab *labels, int count, ffebld expr);
-void ffeste_R838 (ffelab label, ffebld target);
-void ffeste_R839 (ffebld target);
-void ffeste_R840 (ffebld expr, ffelab neg, ffelab zero, ffelab pos);
-void ffeste_R841 (void);
-void ffeste_R842 (ffebld expr);
-void ffeste_R843 (ffebld expr);
-void ffeste_R904 (ffestpOpenStmt *info);
-void ffeste_R907 (ffestpCloseStmt *info);
-void ffeste_R909_start (ffestpReadStmt *info, bool only_format,
-		  ffestvUnit unit, ffestvFormat format, bool rec, bool key);
-void ffeste_R909_item (ffebld expr, ffelexToken expr_token);
-void ffeste_R909_finish (void);
-void ffeste_R910_start (ffestpWriteStmt *info, ffestvUnit unit,
-			ffestvFormat format, bool rec);
-void ffeste_R910_item (ffebld expr, ffelexToken expr_token);
-void ffeste_R910_finish (void);
-void ffeste_R911_start (ffestpPrintStmt *info, ffestvFormat format);
-void ffeste_R911_item (ffebld expr, ffelexToken expr_token);
-void ffeste_R911_finish (void);
-void ffeste_R919 (ffestpBeruStmt *info);
-void ffeste_R920 (ffestpBeruStmt *info);
-void ffeste_R921 (ffestpBeruStmt *info);
-void ffeste_R923A (ffestpInquireStmt *info, bool by_file);
-void ffeste_R923B_start (ffestpInquireStmt *info);
-void ffeste_R923B_item (ffebld expr);
-void ffeste_R923B_finish (void);
-void ffeste_R1001 (ffests s);
-void ffeste_R1103 (void);
-void ffeste_R1112 (void);
-void ffeste_R1212 (ffebld expr);
-void ffeste_R1221 (void);
-void ffeste_R1225 (void);
-void ffeste_R1226 (ffesymbol entry);
-void ffeste_R1227 (ffestw block, ffebld expr);
-void ffeste_V020_start (ffestpTypeStmt *info, ffestvFormat format);
-void ffeste_V020_item (ffebld expr);
-void ffeste_V020_finish (void);
-
-/* Define macros. */
-
-#define ffeste_init_0()
-#define ffeste_init_1()
-#define ffeste_init_2()
-#define ffeste_init_3()
-#define ffeste_init_4()
-#define ffeste_filename() input_filename
-#define ffeste_filelinenum() input_line
-#define ffeste_set_line(name,num) \
-  (input_filename = (name), input_line = (num))
-#define ffeste_terminate_0()
-#define ffeste_terminate_1()
-#ifdef ENABLE_CHECKING
-void ffeste_terminate_2 (void);
-#else
-#define ffeste_terminate_2()
-#endif
-#define ffeste_terminate_3()
-#define ffeste_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STE_H */
diff --git a/gcc/f/storag.c b/gcc/f/storag.c
deleted file mode 100644
index 8e9cb24..0000000
--- a/gcc/f/storag.c
+++ /dev/null
@@ -1,570 +0,0 @@
-/* storag.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Maintains information on storage (memory) relationships between
-      COMMON, dummy, and local variables, plus their equivalences (dummies
-      don't have equivalences, however).
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "storag.h"
-#include "data.h"
-#include "malloc.h"
-#include "symbol.h"
-#include "target.h"
-
-/* Externals defined here. */
-
-ffestoragList_ ffestorag_list_;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-static ffetargetOffset ffestorag_local_size_;	/* #units allocated so far. */
-static bool ffestorag_reported_;/* Reports happen only once. */
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-#define ffestorag_next_(s) ((s)->next)
-#define ffestorag_previous_(s) ((s)->previous)
-
-/* ffestorag_drive -- Drive fn from list of storage objects
-
-   ffestoragList sl;
-   void (*fn)(ffestorag mst,ffestorag st);
-   ffestorag mst;  // the master ffestorag object (or whatever)
-   ffestorag_drive(sl,fn,mst);
-
-   Calls (*fn)(mst,st) for every st in the list sl.  */
-
-void
-ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
-		 ffestorag mst)
-{
-  ffestorag st;
-
-  for (st = sl->first;
-       st != (ffestorag) &sl->first;
-       st = st->next)
-    (*fn) (mst, st);
-}
-
-/* ffestorag_dump -- Dump information on storage object
-
-   ffestorag s;	 // the ffestorag object
-   ffestorag_dump(s);
-
-   Dumps information in the storage object.  */
-
-void
-ffestorag_dump (ffestorag s)
-{
-  if (s == NULL)
-    {
-      fprintf (dmpout, "(no storage object)");
-      return;
-    }
-
-  switch (s->type)
-    {
-    case FFESTORAG_typeCBLOCK:
-      fprintf (dmpout, "CBLOCK ");
-      break;
-
-    case FFESTORAG_typeCOMMON:
-      fprintf (dmpout, "COMMON ");
-      break;
-
-    case FFESTORAG_typeLOCAL:
-      fprintf (dmpout, "LOCAL ");
-      break;
-
-    case FFESTORAG_typeEQUIV:
-      fprintf (dmpout, "EQUIV ");
-      break;
-
-    default:
-      fprintf (dmpout, "?%d? ", s->type);
-      break;
-    }
-
-  if (s->symbol != NULL)
-    fprintf (dmpout, "\"%s\" ", ffesymbol_text (s->symbol));
-
-  fprintf (dmpout, "at %" ffetargetOffset_f "d size %" ffetargetOffset_f
-	   "d, align loc%%%"
-	   ffetargetAlign_f "u=%" ffetargetAlign_f "u, bt=%s, kt=%s",
-	   s->offset,
-	   s->size, (unsigned int) s->alignment, (unsigned int) s->modulo,
-	   ffeinfo_basictype_string (s->basic_type),
-	   ffeinfo_kindtype_string (s->kind_type));
-
-  if (s->equivs_.first != (ffestorag) &s->equivs_.first)
-    {
-      ffestorag sq;
-
-      fprintf (dmpout, " with equivs");
-      for (sq = s->equivs_.first;
-	   sq != (ffestorag) &s->equivs_.first;
-	   sq = ffestorag_next_ (sq))
-	{
-	  if (ffestorag_previous_ (sq) == (ffestorag) &s->equivs_.first)
-	    fputc (' ', dmpout);
-	  else
-	    fputc (',', dmpout);
-	  fprintf (dmpout, "%s", ffesymbol_text (ffestorag_symbol (sq)));
-	}
-    }
-}
-
-/* ffestorag_init_2 -- Initialize for new program unit
-
-   ffestorag_init_2();	*/
-
-void
-ffestorag_init_2 (void)
-{
-  ffestorag_list_.first = ffestorag_list_.last
-  = (ffestorag) &ffestorag_list_.first;
-  ffestorag_local_size_ = 0;
-  ffestorag_reported_ = FALSE;
-}
-
-/* ffestorag_end_layout -- Do final layout for symbol
-
-   ffesymbol s;
-   ffestorag_end_layout(s);  */
-
-void
-ffestorag_end_layout (ffesymbol s)
-{
-  if (ffesymbol_storage (s) != NULL)
-    return;			/* Already laid out. */
-
-  ffestorag_exec_layout (s);	/* Do what we have in common. */
-#if 0
-  assert (ffesymbol_storage (s) == NULL);	/* I'd like to know what
-						   cases miss going through
-						   ffecom_sym_learned, and
-						   why; I don't think we
-						   should have to do the
-						   exec_layout thing at all
-						   here. */
-  /* Now I think I know: we have to do exec_layout here, because equivalence
-     handling could encounter an error that takes a variable off of its
-     equivalence object (and vice versa), and we should then layout the var
-     as a local entity. */
-#endif
-}
-
-/* ffestorag_exec_layout -- Do initial layout for symbol
-
-   ffesymbol s;
-   ffestorag_exec_layout(s);  */
-
-void
-ffestorag_exec_layout (ffesymbol s)
-{
-  ffetargetAlign alignment;
-  ffetargetAlign modulo;
-  ffetargetOffset size;
-  ffetargetOffset num_elements;
-  ffetargetAlign pad;
-  ffestorag st;
-  ffestorag stv;
-  ffebld list;
-  ffebld item;
-  ffesymbol var;
-  bool init;
-
-  if (ffesymbol_storage (s) != NULL)
-    return;			/* Already laid out. */
-
-  switch (ffesymbol_kind (s))
-    {
-    default:
-      return;			/* Do nothing. */
-
-    case FFEINFO_kindENTITY:
-      switch (ffesymbol_where (s))
-	{
-	case FFEINFO_whereLOCAL:
-	  if (ffesymbol_equiv (s) != NULL)
-	    return;		/* Let ffeequiv handle this guy. */
-	  if (ffesymbol_rank (s) == 0)
-	    num_elements = 1;
-	  else
-	    {
-	      if (ffebld_op (ffesymbol_arraysize (s))
-		  != FFEBLD_opCONTER)
-		return;	/* An adjustable local array, just like a dummy. */
-	      num_elements
-		= ffebld_constant_integerdefault (ffebld_conter
-						  (ffesymbol_arraysize (s)));
-	    }
-	  ffetarget_layout (ffesymbol_text (s), &alignment, &modulo,
-			    &size, ffesymbol_basictype (s),
-			    ffesymbol_kindtype (s), ffesymbol_size (s),
-			    num_elements);
-	  st = ffestorag_new (ffestorag_list_master ());
-	  st->parent = NULL;	/* Initializations happen at sym level. */
-	  st->init = NULL;
-	  st->accretion = NULL;
-	  st->symbol = s;
-	  st->size = size;
-	  st->offset = 0;
-	  st->alignment = alignment;
-	  st->modulo = modulo;
-	  st->type = FFESTORAG_typeLOCAL;
-	  st->basic_type = ffesymbol_basictype (s);
-	  st->kind_type = ffesymbol_kindtype (s);
-	  st->type_symbol = s;
-	  st->is_save = ffesymbol_is_save (s);
-	  st->is_init = ffesymbol_is_init (s);
-	  ffesymbol_set_storage (s, st);
-	  if (ffesymbol_is_init (s))
-	    ffecom_notify_init_symbol (s);	/* Init completed before, but
-						   we didn't have a storage
-						   object for it; maybe back
-						   end wants to see the sym
-						   again now. */
-	  ffesymbol_signal_unreported (s);
-	  return;
-
-	case FFEINFO_whereCOMMON:
-	  return;		/* Allocate storage for entire common block
-				   at once. */
-
-	case FFEINFO_whereDUMMY:
-	  return;		/* Don't do anything about dummies for now. */
-
-	case FFEINFO_whereRESULT:
-	case FFEINFO_whereIMMEDIATE:
-	case FFEINFO_whereCONSTANT:
-	case FFEINFO_whereNONE:
-	  return;		/* These don't get storage (esp. NONE, which
-				   is UNCERTAIN). */
-
-	default:
-	  assert ("bad ENTITY where" == NULL);
-	  return;
-	}
-      break;
-
-    case FFEINFO_kindCOMMON:
-      assert (ffesymbol_where (s) == FFEINFO_whereLOCAL);
-      st = ffestorag_new (ffestorag_list_master ());
-      st->parent = NULL;	/* Initializations happen here. */
-      st->init = NULL;
-      st->accretion = NULL;
-      st->symbol = s;
-      st->size = 0;
-      st->offset = 0;
-      st->alignment = 1;
-      st->modulo = 0;
-      st->type = FFESTORAG_typeCBLOCK;
-      if (ffesymbol_commonlist (s) != NULL)
-	{
-	  var = ffebld_symter (ffebld_head (ffesymbol_commonlist (s)));
-	  st->basic_type = ffesymbol_basictype (var);
-	  st->kind_type = ffesymbol_kindtype (var);
-	  st->type_symbol = var;
-	}
-      else
-	{			/* Special case for empty common area:
-				   NONE/NONE means nothing. */
-	  st->basic_type = FFEINFO_basictypeNONE;
-	  st->kind_type = FFEINFO_kindtypeNONE;
-	  st->type_symbol = NULL;
-	}
-      st->is_save = ffesymbol_is_save (s);
-      st->is_init = ffesymbol_is_init (s);
-      if (!ffe_is_mainprog ())
-	ffeglobal_save_common (s,
-			       st->is_save || ffe_is_saveall (),
-			       ffesymbol_where_line (s),
-			       ffesymbol_where_column (s));
-      ffesymbol_set_storage (s, st);
-
-      init = FALSE;
-      for (list = ffesymbol_commonlist (s);
-	   list != NULL;
-	   list = ffebld_trail (list))
-	{
-	  item = ffebld_head (list);
-	  assert (ffebld_op (item) == FFEBLD_opSYMTER);
-	  var = ffebld_symter (item);
-	  if (ffesymbol_basictype (var) == FFEINFO_basictypeANY)
-	    continue;		/* Ignore any symbols that have errors. */
-	  if (ffesymbol_rank (var) == 0)
-	    num_elements = 1;
-	  else
-	    num_elements = ffebld_constant_integerdefault (ffebld_conter
-					       (ffesymbol_arraysize (var)));
-	  ffetarget_layout (ffesymbol_text (var), &alignment, &modulo,
-			    &size, ffesymbol_basictype (var),
-			    ffesymbol_kindtype (var), ffesymbol_size (var),
-			    num_elements);
-	  pad = ffetarget_align (&st->alignment, &st->modulo, st->size,
-				 alignment, modulo);
-	  if (pad != 0)
-	    {			/* Warn about padding in the midst of a
-				   common area. */
-	      char padding[20];
-
-	      sprintf (&padding[0], "%" ffetargetAlign_f "u", pad);
-	      ffebad_start (FFEBAD_COMMON_PAD);
-	      ffebad_string (padding);
-	      ffebad_string (ffesymbol_text (var));
-	      ffebad_string (ffesymbol_text (s));
-	      ffebad_string ((pad == 1)
-			     ? FFECOM_SIZE_UNIT : FFECOM_SIZE_UNITS);
-	      ffebad_here (0, ffesymbol_where_line (s), ffesymbol_where_column (s));
-	      ffebad_finish ();
-	    }
-	  stv = ffestorag_new (ffestorag_list_master ());
-	  stv->parent = st;	/* Initializations happen in COMMON block. */
-	  stv->init = NULL;
-	  stv->accretion = NULL;
-	  stv->symbol = var;
-	  stv->size = size;
-	  if (!ffetarget_offset_add (&stv->offset, st->size, pad))
-	    {			/* Common block size plus pad, complain if
-				   overflow. */
-	      ffetarget_offset_overflow (ffesymbol_text (s));
-	    }
-	  if (!ffetarget_offset_add (&st->size, stv->offset, stv->size))
-	    {			/* Adjust size of common block, complain if
-				   overflow. */
-	      ffetarget_offset_overflow (ffesymbol_text (s));
-	    }
-	  stv->alignment = alignment;
-	  stv->modulo = modulo;
-	  stv->type = FFESTORAG_typeCOMMON;
-	  stv->basic_type = ffesymbol_basictype (var);
-	  stv->kind_type = ffesymbol_kindtype (var);
-	  stv->type_symbol = var;
-	  stv->is_save = st->is_save;
-	  stv->is_init = st->is_init;
-	  ffesymbol_set_storage (var, stv);
-	  ffesymbol_signal_unreported (var);
-	  ffestorag_update (st, var, ffesymbol_basictype (var),
-			    ffesymbol_kindtype (var));
-	  if (ffesymbol_is_init (var))
-	    init = TRUE;	/* Must move inits over to COMMON's
-				   ffestorag. */
-	}
-      if (ffeequiv_layout_cblock (st))
-	init = TRUE;
-      ffeglobal_pad_common (s, st->modulo, ffesymbol_where_line (s),
-			    ffesymbol_where_column (s));
-      if (init)
-	ffedata_gather (st);	/* Gather subordinate inits into one init. */
-      ffesymbol_signal_unreported (s);
-      return;
-    }
-}
-
-/* ffestorag_new -- Create new ffestorag object, append to list
-
-   ffestorag s;
-   ffestoragList sl;
-   s = ffestorag_new(sl);  */
-
-ffestorag
-ffestorag_new (ffestoragList sl)
-{
-  ffestorag s;
-
-  s = malloc_new_kp (ffe_pool_program_unit (), "ffestorag", sizeof (*s));
-  s->next = (ffestorag) &sl->first;
-  s->previous = sl->last;
-  s->hook = FFECOM_storageNULL;
-  s->previous->next = s;
-  sl->last = s;
-  s->equivs_.first = s->equivs_.last = (ffestorag) &s->equivs_.first;
-
-  return s;
-}
-
-/* Report info on LOCAL non-sym-assoc'ed entities if needed.  */
-
-void
-ffestorag_report (void)
-{
-  ffestorag s;
-
-  if (ffestorag_reported_)
-    return;
-
-  for (s = ffestorag_list_.first;
-       s != (ffestorag) &ffestorag_list_.first;
-       s = s->next)
-    {
-      if (s->symbol == NULL)
-	{
-	  ffestorag_reported_ = TRUE;
-	  fputs ("Storage area: ", dmpout);
-	  ffestorag_dump (s);
-	  fputc ('\n', dmpout);
-	}
-    }
-}
-
-/* ffestorag_update -- Update type info for ffestorag object
-
-   ffestorag s;	 // existing object
-   ffeinfoBasictype bt;	 // basic type for newly added member of object
-   ffeinfoKindtype kt;	// kind type for it
-   ffestorag_update(s,bt,kt);
-
-   If the existing type for the storage object agrees with the new type
-   info, just returns.	If the basic types agree but not the kind types,
-   sets the kind type for the object to NONE.  If the basic types
-   disagree, sets the kind type to NONE, and the basic type to NONE if the
-   basic types both are not CHARACTER, otherwise to ANY.  If the basic
-   type for the object already is NONE, it is set to ANY if the new basic
-   type is CHARACTER.  Any time a transition is made to ANY and pedantic
-   mode is on, a message is issued that mixing CHARACTER and non-CHARACTER
-   stuff in the same COMMON/EQUIVALENCE is invalid.  */
-
-void
-ffestorag_update (ffestorag s, ffesymbol sym, ffeinfoBasictype bt,
-		  ffeinfoKindtype kt)
-{
-  if (s->basic_type == bt)
-    {
-      if (s->kind_type == kt)
-	return;
-      s->kind_type = FFEINFO_kindtypeNONE;
-      return;
-    }
-
-  switch (s->basic_type)
-    {
-    case FFEINFO_basictypeANY:
-      return;			/* No need to do anything further. */
-
-    case FFEINFO_basictypeCHARACTER:
-    any:			/* :::::::::::::::::::: */
-      s->basic_type = FFEINFO_basictypeANY;
-      s->kind_type = FFEINFO_kindtypeANY;
-      if (ffe_is_pedantic ())
-	{
-	  ffebad_start (FFEBAD_MIXED_TYPES);
-	  ffebad_string (ffesymbol_text (s->type_symbol));
-	  ffebad_string (ffesymbol_text (sym));
-	  ffebad_finish ();
-	}
-      return;
-
-    default:
-      if (bt == FFEINFO_basictypeCHARACTER)
-	goto any;		/* :::::::::::::::::::: */
-      s->basic_type = FFEINFO_basictypeNONE;
-      s->kind_type = FFEINFO_kindtypeNONE;
-      return;
-    }
-}
-
-/* Update INIT flag for storage object.
-
-   If the INIT flag for the <s> object is already TRUE, return.	 Else,
-   set it to TRUE and call ffe*_update_init for all contained objects.	*/
-
-void
-ffestorag_update_init (ffestorag s)
-{
-  ffestorag sq;
-
-  if (s->is_init)
-    return;
-
-  s->is_init = TRUE;
-
-  if ((s->symbol != NULL)
-      && !ffesymbol_is_init (s->symbol))
-    ffesymbol_update_init (s->symbol);
-
-  if (s->parent != NULL)
-    ffestorag_update_init (s->parent);
-
-  for (sq = s->equivs_.first;
-       sq != (ffestorag) &s->equivs_.first;
-       sq = ffestorag_next_ (sq))
-    {
-      if (!sq->is_init)
-	ffestorag_update_init (sq);
-    }
-}
-
-/* Update SAVE flag for storage object.
-
-   If the SAVE flag for the <s> object is already TRUE, return.	 Else,
-   set it to TRUE and call ffe*_update_save for all contained objects.	*/
-
-void
-ffestorag_update_save (ffestorag s)
-{
-  ffestorag sq;
-
-  if (s->is_save)
-    return;
-
-  s->is_save = TRUE;
-
-  if ((s->symbol != NULL)
-      && !ffesymbol_is_save (s->symbol))
-    ffesymbol_update_save (s->symbol);
-
-  if (s->parent != NULL)
-    ffestorag_update_save (s->parent);
-
-  for (sq = s->equivs_.first;
-       sq != (ffestorag) &s->equivs_.first;
-       sq = ffestorag_next_ (sq))
-    {
-      if (!sq->is_save)
-	ffestorag_update_save (sq);
-    }
-}
diff --git a/gcc/f/storag.h b/gcc/f/storag.h
deleted file mode 100644
index b58dc9a..0000000
--- a/gcc/f/storag.h
+++ /dev/null
@@ -1,165 +0,0 @@
-/* storag.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      storag.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STORAG_H
-#define GCC_F_STORAG_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFESTORAG_typeNONE,
-    FFESTORAG_typeCBLOCK,	/* A COMMON block. */
-    FFESTORAG_typeCOMMON,	/* A COMMON variable. */
-    FFESTORAG_typeLOCAL,	/* A local entity (var/array/equivalence). */
-    FFESTORAG_typeEQUIV,	/* An entity equivalenced into a COMMON/LOCAL
-				   entity. */
-    FFESTORAG_type
-  } ffestoragType;
-
-/* Typedefs. */
-
-typedef struct _ffestorag_ *ffestorag;
-typedef struct _ffestorag_list_ *ffestoragList;
-typedef struct _ffestorag_list_ ffestoragList_;
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "info.h"
-#include "symbol.h"
-#include "target.h"
-
-/* Structure definitions. */
-
-struct _ffestorag_list_
-  {
-    ffestorag first;		/* First storage area in list. */
-    ffestorag last;		/* Last storage area in list. */
-  };
-
-struct _ffestorag_
-  {
-    ffestorag next;		/* Next storage area in list. */
-    ffestorag previous;		/* Previous storage area in list. */
-    ffestorag parent;		/* Parent who holds aggregate
-				   initializations. */
-    ffebld init;		/* Initialization expression. */
-    ffebld accretion;		/* Initializations seen so far for aggregate. */
-    ffetargetOffset accretes;	/* # inits needed to fill entire aggregate. */
-    ffesymbol symbol;		/* NULL if typeLOCAL and non-NULL equivs
-				   and the first "rooted" symbol not known. */
-    ffestoragList_ equivs_;	/* NULL if typeLOCAL and not an EQUIVALENCE
-				   area. */
-    ffetargetOffset size;	/* Size of area. */
-    ffetargetOffset offset;	/* Offset of entity within area, 0 for CBLOCK
-				   and non-equivalence LOCAL, <= 0 for equivalence
-				   LOCAL. */
-    ffetargetAlign alignment;	/* Initial alignment for entity. */
-    ffetargetAlign modulo;	/* Modulo within alignment. */
-    ffecomStorage hook;		/* Whatever the backend needs here. */
-    ffestoragType type;
-    ffeinfoBasictype basic_type;/* NONE= >1 non-CHARACTER; ANY=
-				   CHAR+non-CHAR. */
-    ffeinfoKindtype kind_type;	/* NONE= >1 kind type or NONE/ANY basic_type. */
-    ffesymbol type_symbol;	/* First symbol for basic_type/kind_type. */
-    bool is_save;		/* SAVE flag set for this storage area. */
-    bool is_init;		/* INIT flag set for this storage area. */
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern ffestoragList_ ffestorag_list_;
-
-/* Declare functions with prototypes. */
-
-void ffestorag_drive (ffestoragList sl, void (*fn) (ffestorag mst, ffestorag st),
-		      ffestorag mst);
-void ffestorag_dump (ffestorag s);
-void ffestorag_end_layout (ffesymbol s);
-void ffestorag_exec_layout (ffesymbol s);
-void ffestorag_init_2 (void);
-ffestorag ffestorag_new (ffestoragList sl);
-void ffestorag_report (void);
-void ffestorag_update (ffestorag s, ffesymbol sym, ffeinfoBasictype bt,
-		       ffeinfoKindtype kt);
-void ffestorag_update_init (ffestorag s);
-void ffestorag_update_save (ffestorag s);
-
-/* Define macros. */
-
-#define ffestorag_accretes(s) ((s)->accretes)
-#define ffestorag_accretion(s) ((s)->accretion)
-#define ffestorag_alignment(s) ((s)->alignment)
-#define ffestorag_basictype(s) ((s)->basic_type)
-#define ffestorag_hook(s) ((s)->hook)
-#define ffestorag_init(s) ((s)->init)
-#define ffestorag_init_0()
-#define ffestorag_init_1()
-#define ffestorag_init_3()
-#define ffestorag_init_4()
-#define ffestorag_is_init(s) ((s)->is_init)
-#define ffestorag_is_save(s) ((s)->is_save)
-#define ffestorag_kindtype(s) ((s)->kind_type)
-#define ffestorag_list_equivs(s) (&(s)->equivs_)
-#define ffestorag_list_master() (&ffestorag_list_)
-#define ffestorag_modulo(s) ((s)->modulo)
-#define ffestorag_offset(s) ((s)->offset)
-#define ffestorag_parent(s) ((s)->parent)
-#define ffestorag_ptr_to_alignment(s) (&(s)->alignment)
-#define ffestorag_ptr_to_modulo(s) (&(s)->modulo)
-#define ffestorag_set_accretes(s,a) ((s)->accretes = (a))
-#define ffestorag_set_accretion(s,a) ((s)->accretion = (a))
-#define ffestorag_set_alignment(s,a) ((s)->alignment = (a))
-#define ffestorag_set_basictype(s,b) ((s)->basic_type = (b))
-#define ffestorag_set_hook(s,h) ((s)->hook = (h))
-#define ffestorag_set_init(s,i) ((s)->init = (i))
-#define ffestorag_set_is_init(s,in) ((s)->is_init = (in))
-#define ffestorag_set_is_save(s,sa) ((s)->is_save = (sa))
-#define ffestorag_set_kindtype(s,k) ((s)->kind_type = (k))
-#define ffestorag_set_modulo(s,m) ((s)->modulo = (m))
-#define ffestorag_set_offset(s,o) ((s)->offset = (o))
-#define ffestorag_set_parent(s,p) ((s)->parent = (p))
-#define ffestorag_set_size(s,si) ((s)->size = (si))
-#define ffestorag_set_symbol(s,sy) ((s)->symbol = (sy))
-#define ffestorag_set_type(s,t) ((s)->type = (t))
-#define ffestorag_set_typesymbol(s,sy) ((s)->type_symbol = (sy))
-#define ffestorag_size(s) ((s)->size)
-#define ffestorag_symbol(s) ((s)->symbol)
-#define ffestorag_terminate_0()
-#define ffestorag_terminate_1()
-#define ffestorag_terminate_2()
-#define ffestorag_terminate_3()
-#define ffestorag_terminate_4()
-#define ffestorag_type(s) ((s)->type)
-#define ffestorag_typesymbol(s) ((s)->type_symbol)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STORAG_H */
diff --git a/gcc/f/stp.c b/gcc/f/stp.c
deleted file mode 100644
index 7b8763d..0000000
--- a/gcc/f/stp.c
+++ /dev/null
@@ -1,59 +0,0 @@
-/* stp.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Keeps track of some information needed while parsing (and usually
-      before the exact statement is not confirmed).
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stp.h"
-
-/* Externals defined here. */
-
-union _ffestp_fileu_ ffestp_file;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
diff --git a/gcc/f/stp.h b/gcc/f/stp.h
deleted file mode 100644
index eca8d0d..0000000
--- a/gcc/f/stp.h
+++ /dev/null
@@ -1,508 +0,0 @@
-/* stp.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stp.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STP_H
-#define GCC_F_STP_H
-
-/* Simple definitions and enumerations. */
-
-enum _ffestp_acceptix_
-  {
-    FFESTP_acceptixFORMAT,
-    FFESTP_acceptix
-  };
-typedef enum _ffestp_acceptix_ ffestpAcceptIx;
-
-enum _ffestp_attrib_
-  {
-#if FFESTR_F90
-    FFESTP_attribALLOCATABLE,
-#endif
-    FFESTP_attribDIMENSION,
-    FFESTP_attribEXTERNAL,
-#if FFESTR_F90
-    FFESTP_attribINTENT,
-#endif
-    FFESTP_attribINTRINSIC,
-#if FFESTR_F90
-    FFESTP_attribOPTIONAL,
-#endif
-    FFESTP_attribPARAMETER,
-#if FFESTR_F90
-    FFESTP_attribPOINTER,
-#endif
-#if FFESTR_F90
-    FFESTP_attribPRIVATE,
-    FFESTP_attribPUBLIC,
-#endif
-    FFESTP_attribSAVE,
-#if FFESTR_F90
-    FFESTP_attribTARGET,
-#endif
-    FFESTP_attrib
-  };
-typedef enum _ffestp_attrib_ ffestpAttrib;
-
-enum _ffestp_beruix_
-  {
-    FFESTP_beruixERR,
-    FFESTP_beruixIOSTAT,
-    FFESTP_beruixUNIT,
-    FFESTP_beruix
-  };
-typedef enum _ffestp_beruix_ ffestpBeruIx;
-
-enum _ffestp_closeix_
-  {
-    FFESTP_closeixERR,
-    FFESTP_closeixIOSTAT,
-    FFESTP_closeixSTATUS,
-    FFESTP_closeixUNIT,
-    FFESTP_closeix
-  };
-typedef enum _ffestp_closeix_ ffestpCloseIx;
-
-enum _ffestp_deleteix_
-  {
-    FFESTP_deleteixERR,
-    FFESTP_deleteixIOSTAT,
-    FFESTP_deleteixREC,
-    FFESTP_deleteixUNIT,
-    FFESTP_deleteix
-  };
-typedef enum _ffestp_deleteix_ ffestpDeleteIx;
-
-enum _ffestp_findix_
-  {
-    FFESTP_findixERR,
-    FFESTP_findixIOSTAT,
-    FFESTP_findixREC,
-    FFESTP_findixUNIT,
-    FFESTP_findix
-  };
-typedef enum _ffestp_findix_ ffestpFindIx;
-
-enum _ffestp_inquireix_
-  {
-    FFESTP_inquireixACCESS,
-    FFESTP_inquireixACTION,
-    FFESTP_inquireixBLANK,
-    FFESTP_inquireixCARRIAGECONTROL,
-    FFESTP_inquireixDEFAULTFILE,
-    FFESTP_inquireixDELIM,
-    FFESTP_inquireixDIRECT,
-    FFESTP_inquireixERR,
-    FFESTP_inquireixEXIST,
-    FFESTP_inquireixFILE,
-    FFESTP_inquireixFORM,
-    FFESTP_inquireixFORMATTED,
-    FFESTP_inquireixIOLENGTH,
-    FFESTP_inquireixIOSTAT,
-    FFESTP_inquireixKEYED,
-    FFESTP_inquireixNAME,
-    FFESTP_inquireixNAMED,
-    FFESTP_inquireixNEXTREC,
-    FFESTP_inquireixNUMBER,
-    FFESTP_inquireixOPENED,
-    FFESTP_inquireixORGANIZATION,
-    FFESTP_inquireixPAD,
-    FFESTP_inquireixPOSITION,
-    FFESTP_inquireixREAD,
-    FFESTP_inquireixREADWRITE,
-    FFESTP_inquireixRECL,
-    FFESTP_inquireixRECORDTYPE,
-    FFESTP_inquireixSEQUENTIAL,
-    FFESTP_inquireixUNFORMATTED,
-    FFESTP_inquireixUNIT,
-    FFESTP_inquireixWRITE,
-    FFESTP_inquireix
-  };
-typedef enum _ffestp_inquireix_ ffestpInquireIx;
-
-enum _ffestp_openix_
-  {
-    FFESTP_openixACCESS,
-    FFESTP_openixACTION,
-    FFESTP_openixASSOCIATEVARIABLE,
-    FFESTP_openixBLANK,
-    FFESTP_openixBLOCKSIZE,
-    FFESTP_openixBUFFERCOUNT,
-    FFESTP_openixCARRIAGECONTROL,
-    FFESTP_openixDEFAULTFILE,
-    FFESTP_openixDELIM,
-    FFESTP_openixDISPOSE,
-    FFESTP_openixERR,
-    FFESTP_openixEXTENDSIZE,
-    FFESTP_openixFILE,
-    FFESTP_openixFORM,
-    FFESTP_openixINITIALSIZE,
-    FFESTP_openixIOSTAT,
-    FFESTP_openixKEY,
-    FFESTP_openixMAXREC,
-    FFESTP_openixNOSPANBLOCKS,
-    FFESTP_openixORGANIZATION,
-    FFESTP_openixPAD,
-    FFESTP_openixPOSITION,
-    FFESTP_openixREADONLY,
-    FFESTP_openixRECL,
-    FFESTP_openixRECORDTYPE,
-    FFESTP_openixSHARED,
-    FFESTP_openixSTATUS,
-    FFESTP_openixUNIT,
-    FFESTP_openixUSEROPEN,
-    FFESTP_openix
-  };
-typedef enum _ffestp_openix_ ffestpOpenIx;
-
-enum _ffestp_printix_
-  {
-    FFESTP_printixFORMAT,
-    FFESTP_printix
-  };
-typedef enum _ffestp_printix_ ffestpPrintIx;
-
-enum _ffestp_readix_
-  {
-    FFESTP_readixADVANCE,
-    FFESTP_readixEND,
-    FFESTP_readixEOR,
-    FFESTP_readixERR,
-    FFESTP_readixFORMAT,	/* Or NAMELIST (use expr info to
-				   distinguish). */
-    FFESTP_readixIOSTAT,
-    FFESTP_readixKEYEQ,
-    FFESTP_readixKEYGE,
-    FFESTP_readixKEYGT,
-    FFESTP_readixKEYID,
-    FFESTP_readixNULLS,
-    FFESTP_readixREC,
-    FFESTP_readixSIZE,
-    FFESTP_readixUNIT,
-    FFESTP_readix
-  };
-typedef enum _ffestp_readix_ ffestpReadIx;
-
-enum _ffestp_rewriteix_
-  {
-    FFESTP_rewriteixERR,
-    FFESTP_rewriteixFMT,
-    FFESTP_rewriteixIOSTAT,
-    FFESTP_rewriteixUNIT,
-    FFESTP_rewriteix
-  };
-typedef enum _ffestp_rewriteix_ ffestpRewriteIx;
-
-enum _ffestp_typeix_
-  {
-    FFESTP_typeixFORMAT,
-    FFESTP_typeix
-  };
-typedef enum _ffestp_typeix_ ffestpTypeIx;
-
-enum _ffestp_vxtcodeix_
-  {
-    FFESTP_vxtcodeixB,
-    FFESTP_vxtcodeixC,
-    FFESTP_vxtcodeixERR,
-    FFESTP_vxtcodeixF,
-    FFESTP_vxtcodeixIOSTAT,
-    FFESTP_vxtcodeix
-  };
-typedef enum _ffestp_vxtcodeix_ ffestpVxtcodeIx;
-
-enum _ffestp_writeix_
-  {
-    FFESTP_writeixADVANCE,
-    FFESTP_writeixEOR,
-    FFESTP_writeixERR,
-    FFESTP_writeixFORMAT,	/* Or NAMELIST (use expr info to
-				   distinguish). */
-    FFESTP_writeixIOSTAT,
-    FFESTP_writeixREC,
-    FFESTP_writeixUNIT,
-    FFESTP_writeix
-  };
-typedef enum _ffestp_writeix_ ffestpWriteIx;
-
-#if FFESTR_F90
-enum _ffestp_definedoperator_
-  {
-    FFESTP_definedoperatorNone,	/* INTERFACE generic-name. */
-    FFESTP_definedoperatorOPERATOR,	/* INTERFACE
-					   OPERATOR(defined-operator). */
-    FFESTP_definedoperatorASSIGNMENT,	/* INTERFACE ASSIGNMENT(=). */
-    FFESTP_definedoperatorPOWER,
-    FFESTP_definedoperatorMULT,
-    FFESTP_definedoperatorADD,
-    FFESTP_definedoperatorCONCAT,
-    FFESTP_definedoperatorDIVIDE,
-    FFESTP_definedoperatorSUBTRACT,
-    FFESTP_definedoperatorNOT,
-    FFESTP_definedoperatorAND,
-    FFESTP_definedoperatorOR,
-    FFESTP_definedoperatorEQV,
-    FFESTP_definedoperatorNEQV,
-    FFESTP_definedoperatorEQ,
-    FFESTP_definedoperatorNE,
-    FFESTP_definedoperatorLT,
-    FFESTP_definedoperatorLE,
-    FFESTP_definedoperatorGT,
-    FFESTP_definedoperatorGE,
-    FFESTP_definedoperator
-  };
-typedef enum _ffestp_definedoperator_ ffestpDefinedOperator;
-#endif
-
-enum _ffestp_dimtype_
-  {
-    FFESTP_dimtypeNONE,
-    FFESTP_dimtypeKNOWN,	/* Known-bounds dimension list. */
-    FFESTP_dimtypeADJUSTABLE,	/* Adjustable dimension list. */
-    FFESTP_dimtypeASSUMED,	/* Assumed dimension list (known except for
-				   last). */
-    FFESTP_dimtypeADJUSTABLEASSUMED,	/* Both. */
-    FFESTP_dimtype
-  };
-typedef enum _ffestp_dimtype_ ffestpDimtype;
-
-enum _ffestp_formattype_
-  {
-    FFESTP_formattypeNone,
-    FFESTP_formattypeI,
-    FFESTP_formattypeB,
-    FFESTP_formattypeO,
-    FFESTP_formattypeZ,
-    FFESTP_formattypeF,
-    FFESTP_formattypeE,
-    FFESTP_formattypeEN,
-    FFESTP_formattypeG,
-    FFESTP_formattypeL,
-    FFESTP_formattypeA,
-    FFESTP_formattypeD,
-    FFESTP_formattypeQ,
-    FFESTP_formattypeDOLLAR,	/* $ (V-extension). */
-    FFESTP_formattypeP,
-    FFESTP_formattypeT,
-    FFESTP_formattypeTL,
-    FFESTP_formattypeTR,
-    FFESTP_formattypeX,
-    FFESTP_formattypeS,
-    FFESTP_formattypeSP,
-    FFESTP_formattypeSS,
-    FFESTP_formattypeBN,
-    FFESTP_formattypeBZ,
-    FFESTP_formattypeH,		/* Hollerith, used only for error-reporting. */
-    FFESTP_formattypeSLASH,
-    FFESTP_formattypeCOLON,
-    FFESTP_formattypeR1016,	/* char-literal-constant or cHchars. */
-    FFESTP_formattypeFORMAT,	/* [r](format-item-list). */
-    FFESTP_formattype
-  };
-typedef enum _ffestp_formattype_ ffestpFormatType;
-
-enum _ffestp_type_
-  {
-    FFESTP_typeNone,
-    FFESTP_typeINTEGER,
-    FFESTP_typeREAL,
-    FFESTP_typeCOMPLEX,
-    FFESTP_typeLOGICAL,
-    FFESTP_typeCHARACTER,
-    FFESTP_typeDBLPRCSN,
-    FFESTP_typeDBLCMPLX,
-    FFESTP_typeBYTE,
-    FFESTP_typeWORD,
-#if FFESTR_F90
-    FFESTP_typeTYPE,
-#endif
-    FFESTP_type
-  };
-typedef enum _ffestp_type_ ffestpType;
-
-/* Typedefs. */
-
-typedef struct _ffest_accept_stmt_ ffestpAcceptStmt;
-typedef struct _ffest_beru_stmt_ ffestpBeruStmt;
-typedef struct _ffest_close_stmt_ ffestpCloseStmt;
-typedef struct _ffest_delete_stmt_ ffestpDeleteStmt;
-typedef struct _ffestp_file ffestpFile;
-typedef struct _ffest_find_stmt_ ffestpFindStmt;
-typedef struct _ffest_inquire_stmt_ ffestpInquireStmt;
-typedef struct _ffest_open_stmt_ ffestpOpenStmt;
-typedef struct _ffest_print_stmt_ ffestpPrintStmt;
-typedef struct _ffest_read_stmt_ ffestpReadStmt;
-typedef struct _ffest_rewrite_stmt_ ffestpRewriteStmt;
-typedef struct _ffest_type_stmt_ ffestpTypeStmt;
-typedef struct _ffest_vxtcode_stmt_ ffestpVxtcodeStmt;
-typedef struct _ffest_write_stmt_ ffestpWriteStmt;
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "lab.h"
-#include "lex.h"
-#include "stp.h"
-#include "stt.h"
-
-/* Structure definitions. */
-
-struct _ffestp_file
-  {
-    bool kw_or_val_present;	/* If FALSE, all else is n/a. */
-    bool kw_present;		/* Indicates whether kw has a token. */
-    bool value_present;		/* Indicates whether value/expr are valid. */
-    bool value_is_label;	/* TRUE if expr has no expression, value is
-				   NUMBER. */
-    ffelexToken kw;		/* The keyword, iff kw_or_val_present &&
-				   kw_present. */
-    ffelexToken value;		/* The value, iff kw_or_val_present &&
-				   value_present. */
-    union
-      {
-	ffebld expr;		/* The expr, iff kw_or_val_present &&
-				   value_present && !value_is_label. */
-	ffelab label;		/* The label, iff kw_or_val_present &&
-				   value_present && value_is_label. */
-      }
-    u;
-  };
-
-struct _ffest_accept_stmt_
-  {
-    ffestpFile accept_spec[FFESTP_acceptix];
-  };
-
-struct _ffest_beru_stmt_
-  {
-    ffestpFile beru_spec[FFESTP_beruix];
-  };
-
-struct _ffest_close_stmt_
-  {
-    ffestpFile close_spec[FFESTP_closeix];
-  };
-
-struct _ffest_delete_stmt_
-  {
-    ffestpFile delete_spec[FFESTP_deleteix];
-  };
-
-struct _ffest_find_stmt_
-  {
-    ffestpFile find_spec[FFESTP_findix];
-  };
-
-struct _ffest_imp_list_
-  {
-    ffesttImpList next;
-    ffesttImpList previous;
-    ffelexToken first;
-    ffelexToken last;		/* NULL if a single letter. */
-  };
-
-struct _ffest_inquire_stmt_
-  {
-    ffestpFile inquire_spec[FFESTP_inquireix];
-  };
-
-struct _ffest_open_stmt_
-  {
-    ffestpFile open_spec[FFESTP_openix];
-  };
-
-struct _ffest_print_stmt_
-  {
-    ffestpFile print_spec[FFESTP_printix];
-  };
-
-struct _ffest_read_stmt_
-  {
-    ffestpFile read_spec[FFESTP_readix];
-  };
-
-struct _ffest_rewrite_stmt_
-  {
-    ffestpFile rewrite_spec[FFESTP_rewriteix];
-  };
-
-struct _ffest_type_stmt_
-  {
-    ffestpFile type_spec[FFESTP_typeix];
-  };
-
-struct _ffest_vxtcode_stmt_
-  {
-    ffestpFile vxtcode_spec[FFESTP_vxtcodeix];
-  };
-
-struct _ffest_write_stmt_
-  {
-    ffestpFile write_spec[FFESTP_writeix];
-  };
-
-union _ffestp_fileu_
-  {
-    ffestpAcceptStmt accept;
-    ffestpBeruStmt beru;
-    ffestpCloseStmt close;
-    ffestpDeleteStmt delete;
-    ffestpFindStmt find;
-    ffestpInquireStmt inquire;
-    ffestpOpenStmt open;
-    ffestpPrintStmt print;
-    ffestpReadStmt read;
-    ffestpRewriteStmt rewrite;
-    ffestpTypeStmt type;
-    ffestpVxtcodeStmt vxtcode;
-    ffestpWriteStmt write;
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern union _ffestp_fileu_ ffestp_file;
-
-/* Declare functions with prototypes. */
-
-
-/* Define macros. */
-
-#define ffestp_init_0()
-#define ffestp_init_1()
-#define ffestp_init_2()
-#define ffestp_init_3()
-#define ffestp_init_4()
-#define ffestp_terminate_0()
-#define ffestp_terminate_1()
-#define ffestp_terminate_2()
-#define ffestp_terminate_3()
-#define ffestp_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STP_H */
diff --git a/gcc/f/str-1t.fin b/gcc/f/str-1t.fin
deleted file mode 100644
index b74f583..0000000
--- a/gcc/f/str-1t.fin
+++ /dev/null
@@ -1,135 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_first // // ffestrFirst ffestr_first 1 1
-;Accept ACCEPT
-;Allocatable ALLOCATABLE
-;Allocate ALLOCATE
-Assign ASSIGN
-Backspace BACKSPACE
-Block BLOCK
-BlockData BLOCKDATA
-Byte BYTE
-Call CALL
-Case CASE
-CaseDefault CASEDEFAULT
-Character CHRCTR
-Close CLOSE
-Common COMMON
-Complex CMPLX
-;Contains CONTAINS
-Continue CONTINUE
-Cycle CYCLE
-Data DATA
-;Deallocate DEALLOCATE
-Decode DECODE
-Define DEFINE
-;DefineFile DEFINEFILE
-Delete DELETE
-Dimension DIMENSION
-Do DO
-Double DBL
-DoubleComplex DBLCMPLX
-DoublePrecision DBLPRCSN
-DoWhile DOWHILE
-Else ELSE
-ElseIf ELSEIF
-;ElseWhere ELSEWHERE
-Encode ENCODE
-End END
-EndBlock ENDBLOCK
-EndBlockData ENDBLOCKDATA
-EndDo ENDDO
-EndFile ENDFILE
-EndFunction ENDFUNCTION
-EndIf ENDIF
-;EndInterface ENDINTERFACE
-;EndMap ENDMAP
-;EndModule ENDMODULE
-EndProgram ENDPROGRAM
-EndSelect ENDSELECT
-;EndStructure ENDSTRUCTURE
-EndSubroutine ENDSUBROUTINE
-;EndType ENDTYPE
-;EndUnion ENDUNION
-;EndWhere ENDWHERE
-Entry ENTRY
-Equivalence EQUIVALENCE
-Exit EXIT
-External EXTERNAL
-Find FIND
-Format FORMAT
-Function FUNCTION
-Go GO
-GoTo GOTO
-If IF
-Implicit IMPLICIT
-Include INCLUDE
-Inquire INQUIRE
-Integer INTGR
-;Intent INTENT
-;Interface INTERFACE
-;InterfaceAssignment INTERFACEASSGNMNT
-;InterfaceOperator INTERFACEOPERATOR
-Intrinsic INTRINSIC
-Logical LGCL
-;Map MAP
-;Module MODULE
-;ModuleProcedure MODULEPROCEDURE
-NameList NAMELIST
-;Nullify NULLIFY
-Open OPEN
-;Optional OPTIONAL
-Parameter PARAMETER
-Pause PAUSE
-;Pointer POINTER
-Print PRINT
-;Private PRIVATE
-Program PROGRAM
-;Public PUBLIC
-Read READ
-Real REAL
-;Record RECORD
-;Recursive RECURSIVE
-;RecursiveFunction RECURSIVEFNCTN
-Return RETURN
-Rewind REWIND
-;Rewrite REWRITE
-Save SAVE
-Select SELECT
-SelectCase SELECTCASE
-;Sequence SEQUENCE
-Stop STOP
-;Structure STRUCTURE
-Subroutine SUBROUTINE
-;Target TARGET
-Then THEN
-Type TYPE
-;Union UNION
-;Unlock UNLOCK
-;Use USE
-Virtual VIRTUAL
-Volatile VOLATILE
-;Where WHERE
-Word WORD
-Write WRITE
diff --git a/gcc/f/str-2t.fin b/gcc/f/str-2t.fin
deleted file mode 100644
index d0ba9fc..0000000
--- a/gcc/f/str-2t.fin
+++ /dev/null
@@ -1,60 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_second // // ffestrSecond ffestr_second 1 0
-;Assignment ASSIGNMENT
-Block BLOCK
-BlockData BLOCKDATA
-Byte BYTE
-Case CASE
-Character CHARACTER
-Complex COMPLEX
-Data DATA
-Default DEFAULT
-Do DO
-Double DOUBLE
-DoubleComplex DOUBLECOMPLEX
-DoublePrecision DOUBLEPRECISION
-File FILE
-Function FUNCTION
-If IF
-Integer INTEGER
-;Interface INTERFACE
-Logical LOGICAL
-;Map MAP
-;Module MODULE
-None NONE
-;Operator OPERATOR
-Precision PRECISION
-;Procedure PROCEDURE
-Program PROGRAM
-Real REAL
-Select SELECT
-;Structure STRUCTURE
-Subroutine SUBROUTINE
-To TO
-;Type TYPE
-;Union UNION
-;Where WHERE
-While WHILE
-Word WORD
diff --git a/gcc/f/str-fo.fin b/gcc/f/str-fo.fin
deleted file mode 100644
index ea39b6c..0000000
--- a/gcc/f/str-fo.fin
+++ /dev/null
@@ -1,55 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_format // // ffestrFormat ffestr_format 0 1
-$ DOLLAR
-A A
-B B
-BN BN
-BZ BZ
-D D
-E E
-En EN
-F F
-G G
-H H
-I I
-L L
-N N
-O O
-P P
-PD PD
-PE PE
-PEn PEN
-PF PF
-PG PG
-Q Q
-R R
-S S
-SP SP
-SS SS
-T T
-TL TL
-TR TR
-X X
-Z Z
diff --git a/gcc/f/str-io.fin b/gcc/f/str-io.fin
deleted file mode 100644
index efd4008..0000000
--- a/gcc/f/str-io.fin
+++ /dev/null
@@ -1,43 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_genio // // ffestrGenio ffestr_genio 1 0
-Advance ADVANCE
-Disp DISP
-Dispose DISPOSE
-End END
-EoR EOR
-Err ERR
-Fmt FMT
-IOStat IOSTAT
-Key KEY
-KeyEQ KEYEQ
-KeyGE KEYGE
-KeyGT KEYGT
-KeyID KEYID
-Nml NML
-Nulls NULLS
-Rec REC
-Size SIZE
-Status STATUS
-Unit UNIT
diff --git a/gcc/f/str-nq.fin b/gcc/f/str-nq.fin
deleted file mode 100644
index 3cdae08..0000000
--- a/gcc/f/str-nq.fin
+++ /dev/null
@@ -1,55 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_inquire // // ffestrInquire ffestr_inquire 1 0
-Access ACCESS
-Action ACTION
-Blank BLANK
-CarriageControl CARRIAGECONTROL
-DefaultFile DEFAULTFILE
-Delim DELIM
-Direct DIRECT
-Err ERR
-Exist EXIST
-File FILE
-Form FORM
-Formatted FORMATTED
-IOLength IOLENGTH
-IOStat IOSTAT
-Keyed KEYED
-Name NAME
-Named NAMED
-NextRec NEXTREC
-Number NUMBER
-Opened OPENED
-Organization ORGANIZATION
-Pad PAD
-Position POSITION
-Read READ
-ReadWrite READWRITE
-RecL RECL
-RecordType RECORDTYPE
-Sequential SEQUENTIAL
-Unformatted UNFORMATTED
-Unit UNIT
-Write WRITE
diff --git a/gcc/f/str-op.fin b/gcc/f/str-op.fin
deleted file mode 100644
index b7a5112..0000000
--- a/gcc/f/str-op.fin
+++ /dev/null
@@ -1,57 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_open // // ffestrOpen ffestr_open 1 0
-Access ACCESS
-Action ACTION
-AssociateVariable ASSOCIATEVARIABLE
-Blank BLANK
-BlockSize BLOCKSIZE
-BufferCount BUFFERCOUNT
-CarriageControl CARRIAGECONTROL
-DefaultFile DEFAULTFILE
-Delim DELIM
-Disp DISP
-Dispose DISPOSE
-Err ERR
-ExtendSize EXTENDSIZE
-File FILE
-Form FORM
-InitialSize INITIALSIZE
-IOStat IOSTAT
-Key KEY
-MaxRec MAXREC
-Name NAME
-NoSpanBlocks NOSPANBLOCKS
-Organization ORGANIZATION
-Pad PAD
-Position POSITION
-Readonly READONLY
-Recl RECL
-RecordSize RECORDSIZE
-RecordType RECORDTYPE
-Shared SHARED
-Status STATUS
-Type TYPE
-Unit UNIT
-UserOpen USEROPEN
diff --git a/gcc/f/str-ot.fin b/gcc/f/str-ot.fin
deleted file mode 100644
index c96b59c..0000000
--- a/gcc/f/str-ot.fin
+++ /dev/null
@@ -1,50 +0,0 @@
-{
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-}
-
-FFESTR_other // // ffestrOther ffestr_other 1 1
-And AND
-;Dimension DIMENSION
-Eq EQ
-Eqv EQV
-False FALSE
-GE GE
-GT GT
-In IN
-InOut INOUT
-Kind KIND
-LE LE
-Len LEN
-LT LT
-NE NE
-NEqv NEQV
-Not NOT
-;Only ONLY
-Or OR
-Out OUT
-;Pointer POINTER
-;Private PRIVATE
-;Public PUBLIC
-Result RESULT
-;Stat STAT
-True TRUE
-XOr XOR
diff --git a/gcc/f/str.c b/gcc/f/str.c
deleted file mode 100644
index f03c893..0000000
--- a/gcc/f/str.c
+++ /dev/null
@@ -1,217 +0,0 @@
-/* str.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Handles recognition of keywords.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "src.h"
-#include "str.h"
-#include "lex.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffestr_first -- Look up the first names in a statement
-
-   ffestrFirst kw;
-   ffelexToken t;
-   kw = ffestr_first(t);
-
-   Returns FFESTR_firstNone if no matches, else FFESTR_firstXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_first.fini", consisting primarily of a
-   list of statements (ASSIGN, IF, DO, DOWHILE), and outputs a C file,
-   "str-1t.j", that contains the definition of the
-   ffestr_first function.  We #include that file here.
-
-   30-Jan-90  JCB  2.0
-      Updated for Fortran 90.
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-1t.j"
-#endif
-/* ffestr_format -- Look up format names in a statement
-
-   ffestrFormat kw;
-   ffelexToken t;
-   kw = ffestr_format(t);
-
-   Returns FFESTR_formatNone if no matches, else FFESTR_formatXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_format.fini", consisting primarily of a
-   list of format keywords (I, F, TL, TR), and outputs a C file,
-   "str-fo.j", that contains the definition of the
-   ffestr_format function.  We #include that file here.
-
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-fo.j"
-#endif
-/* ffestr_genio -- Look up genio names in a statement
-
-   ffestrGenio kw;
-   ffelexToken t;
-   kw = ffestr_genio(t);
-
-   Returns FFESTR_genioNone if no matches, else FFESTR_genioXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_genio.fini", consisting primarily of a
-   list of statement keywords (TO, FUNCTION), and outputs a C file,
-   "str-io.j", that contains the definition of the
-   ffestr_genio function.  We #include that file here.
-
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-io.j"
-#endif
-/* ffestr_inquire -- Look up inquire names in a statement
-
-   ffestrInquire kw;
-   ffelexToken t;
-   kw = ffestr_inquire(t);
-
-   Returns FFESTR_inquireNone if no matches, else FFESTR_inquireXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_inquire.fini", consisting primarily of a
-   list of statement keywords (TO, FUNCTION), and outputs a C file,
-   "str-nq.j", that contains the definition of the
-   ffestr_inquire function.  We #include that file here.
-
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-nq.j"
-#endif
-/* ffestr_open -- Look up open names in a statement
-
-   ffestrOpen kw;
-   ffelexToken t;
-   kw = ffestr_open(t);
-
-   Returns FFESTR_openNone if no matches, else FFESTR_openXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_open.fini", consisting primarily of a
-   list of statement keywords (TO, FUNCTION), and outputs a C file,
-   "str-op.j", that contains the definition of the
-   ffestr_open function.  We #include that file here.
-
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-op.j"
-#endif
-/* ffestr_other -- Look up other names in a statement
-
-   ffestrOther kw;
-   ffelexToken t;
-   kw = ffestr_other(t);
-
-   Returns FFESTR_otherNone if no matches, else FFESTR_otherXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_other.fini", consisting primarily of a
-   list of statement keywords (TO, FUNCTION), and outputs a C file,
-   "str-ot.j", that contains the definition of the
-   ffestr_other function.  We #include that file here.
-
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-ot.j"
-#endif
-/* ffestr_second -- Look up the second name in a statement
-
-   ffestrSecond kw;
-   ffelexToken t;
-   kw = ffestr_second(t);
-
-   Returns FFESTR_secondNone if no matches, else FFESTR_secondXYZ if the
-   NAME or NAMES token matches XYZ.  t must be a NAME or NAMES token or this
-   routine will crash.
-
-   This routine's code is actually written by a utility called FINI, itself
-   written specifically for the Gnu Fortran project.  FINI takes an input
-   file, in this case "ffe_second.fini", consisting primarily of a
-   list of statement keywords (TO, FUNCTION), and outputs a C file,
-   "str-2t.j", that contains the definition of the
-   ffestr_second function.  We #include that file here.
-
-*/
-
-#ifndef MAKING_DEPENDENCIES
-#include "str-2t.j"
-#endif
diff --git a/gcc/f/str.h b/gcc/f/str.h
deleted file mode 100644
index b3ac04e..0000000
--- a/gcc/f/str.h
+++ /dev/null
@@ -1,80 +0,0 @@
-/* str.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      str.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STR_H
-#define GCC_F_STR_H
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "lex.h"
-#ifndef MAKING_DEPENDENCIES
-#include "str-1t.h"
-#include "str-fo.h"
-#include "str-io.h"
-#include "str-nq.h"
-#include "str-ot.h"
-#include "str-op.h"
-#include "str-2t.h"
-#endif
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-ffestrFirst ffestr_first (ffelexToken t);
-ffestrFormat ffestr_format (ffelexToken t);
-ffestrGenio ffestr_genio (ffelexToken t);
-ffestrInquire ffestr_inquire (ffelexToken t);
-ffestrOpen ffestr_open (ffelexToken t);
-ffestrOther ffestr_other (ffelexToken t);
-ffestrSecond ffestr_second (ffelexToken t);
-
-/* Define macros. */
-
-#define ffestr_init_0()
-#define ffestr_init_1()
-#define ffestr_init_2()
-#define ffestr_init_3()
-#define ffestr_init_4()
-#define ffestr_terminate_0()
-#define ffestr_terminate_1()
-#define ffestr_terminate_2()
-#define ffestr_terminate_3()
-#define ffestr_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STR_H */
diff --git a/gcc/f/sts.c b/gcc/f/sts.c
deleted file mode 100644
index 63bf77a..0000000
--- a/gcc/f/sts.c
+++ /dev/null
@@ -1,179 +0,0 @@
-/* sts.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None (despite the name, it doesn't really depend on ffest*)
-
-   Description:
-      Provides an arbitrary-length string facility for the limited needs of
-      GNU Fortran FORMAT statement generation.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "sts.h"
-#include "com.h"
-#include "malloc.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffests_kill -- Kill a varying-length string
-
-   ffests s;
-   ffests_kill(s);
-
-   The storage associated with the string <s> is freed.	 */
-
-void
-ffests_kill (ffests s)
-{
-  if (s->text_ != NULL)
-    malloc_kill_ksr (s->pool_, s->text_, s->max_);
-}
-
-/* ffests_new -- Make a varying-length string
-
-   ffests s;
-   ffests_new(s,malloc_pool_image(),0);
-
-   The string is initialized to hold, in this case, 0 characters, and
-   current and future heap manipulations to hold the string will use
-   the image pool.  */
-
-void
-ffests_new (ffests s, mallocPool pool, ffestsLength size)
-{
-  s->pool_ = pool;
-  s->len_ = 0;
-  s->max_ = size;
-
-  if (size == 0)
-    s->text_ = NULL;
-  else
-    s->text_ = malloc_new_ksr (pool, "ffests", size);
-}
-
-/* ffests_printf -- printf ("...%ld...",(long)) to a string
-
-   ffests s;
-   ffests_printf (s,"...%ld...",1);
-
-   Like printf, but into a string.  */
-
-void
-ffests_printf (ffests s, const char *ctl, ...)
-{
-  char *string;
-  va_list ap;
-  
-  va_start (ap, ctl);
-  if (vasprintf (&string, ctl, ap) == 0)
-    abort ();
-  va_end (ap);
-  ffests_puts (s, string);
-  free (string);
-}
-
-/* ffests_putc -- Put a single character into string
-
-   ffests s;
-   ffests_putc(s,'*');	*/
-
-void
-ffests_putc (ffests s, char c)
-{
-  ffests_puttext (s, &c, 1);
-}
-
-/* ffests_puts -- Put a zero-terminated (C-style) string into string
-
-   ffests s;
-   ffests_puts(s,"append me");	*/
-
-void
-ffests_puts (ffests s, const char *string)
-{
-  ffests_puttext (s, string, strlen (string));
-}
-
-/* ffests_puttext -- Put a number of characters into string
-
-   ffests s;
-   ffests_puttext(s,"hi there",8);
-
-   The string need not be 0-terminated, because the passed length is used,
-   and may be 0.  */
-
-void
-ffests_puttext (ffests s, const char *text, ffestsLength length)
-{
-  ffestsLength newlen;
-  ffestsLength newmax;
-
-  if (length <= 0)
-    return;
-
-  newlen = s->len_ + length;
-  if (newlen > s->max_)
-    {
-      if (s->text_ == NULL)
-	{
-	  s->max_ = 40;
-	  s->text_ = malloc_new_ksr (s->pool_, "ffests", s->max_);
-	}
-      else
-	{
-	  newmax = s->max_ << 1;
-	  while (newmax < newlen)
-	    newmax <<= 1;
-	  s->text_ = malloc_resize_ksr (s->pool_, s->text_, newmax, s->max_);
-	  s->max_ = newmax;
-	}
-    }
-
-  memcpy (s->text_ + s->len_, text, length);
-  s->len_ = newlen;
-}
diff --git a/gcc/f/sts.h b/gcc/f/sts.h
deleted file mode 100644
index 3ca494d..0000000
--- a/gcc/f/sts.h
+++ /dev/null
@@ -1,85 +0,0 @@
-/* sts.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      sts.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STS_H
-#define GCC_F_STS_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-typedef struct _ffests_ *ffests;
-typedef struct _ffests_ ffestsHolder;
-typedef unsigned long int ffestsLength;
-
-/* Include files needed by this one. */
-
-#include "malloc.h"
-
-/* Structure definitions. */
-
-struct _ffests_
-  {
-    char *text_;
-    mallocPool pool_;
-    ffestsLength len_;
-    ffestsLength max_;
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffests_kill (ffests s);
-void ffests_new (ffests s, mallocPool pool, ffestsLength size);
-void ffests_printf (ffests s, const char *ctl, ...) ATTRIBUTE_PRINTF_2;
-void ffests_putc (ffests s, char c);
-void ffests_puts (ffests s, const char *string);
-void ffests_puttext (ffests s, const char *text, ffestsLength length);
-
-/* Define macros. */
-
-#define ffests_init_0()
-#define ffests_init_1()
-#define ffests_init_2()
-#define ffests_init_3()
-#define ffests_init_4()
-#define ffests_length(s) ((s)->len_)
-#define ffests_terminate_0()
-#define ffests_terminate_1()
-#define ffests_terminate_2()
-#define ffests_terminate_3()
-#define ffests_terminate_4()
-#define ffests_text(s) ((s)->text_)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STS_H */
diff --git a/gcc/f/stt.c b/gcc/f/stt.c
deleted file mode 100644
index e616d49..0000000
--- a/gcc/f/stt.c
+++ /dev/null
@@ -1,892 +0,0 @@
-/* stt.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1997, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Manages lists of tokens and related info for parsing.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stt.h"
-#include "bld.h"
-#include "expr.h"
-#include "info.h"
-#include "lex.h"
-#include "malloc.h"
-#include "sta.h"
-#include "stp.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffestt_caselist_append -- Append case to list of cases
-
-   ffesttCaseList list;
-   ffelexToken t;
-   ffestt_caselist_append(list,range,case1,case2,t);
-
-   list must have already been created by ffestt_caselist_create.  The
-   list is allocated out of the scratch pool.  The token is consumed.  */
-
-void
-ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
-			ffebld case2, ffelexToken t)
-{
-  ffesttCaseList 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;
-  new->previous->next = new;
-  new->expr1 = case1;
-  new->expr2 = case2;
-  new->range = range;
-  new->t = t;
-}
-
-/* ffestt_caselist_create -- Create new list of cases
-
-   ffesttCaseList list;
-   list = ffestt_caselist_create();
-
-   The list is allocated out of the scratch pool.  */
-
-ffesttCaseList
-ffestt_caselist_create (void)
-{
-  ffesttCaseList 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;
-  new->expr2 = NULL;
-  new->range = FALSE;
-  return new;
-}
-
-/* ffestt_caselist_kill -- Kill list of cases
-
-   ffesttCaseList list;
-   ffestt_caselist_kill(list);
-
-   The tokens on the list are killed.
-
-   02-Mar-90  JCB  1.1
-      Don't kill the list itself or change it, since it will be trashed when
-      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
-
-void
-ffestt_caselist_kill (ffesttCaseList list)
-{
-  ffesttCaseList next;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      ffelex_token_kill (next->t);
-    }
-}
-
-/* ffestt_dimlist_append -- Append dim to list of dims
-
-   ffesttDimList list;
-   ffelexToken t;
-   ffestt_dimlist_append(list,lower,upper,t);
-
-   list must have already been created by ffestt_dimlist_create.  The
-   list is allocated out of the scratch pool.  The token is consumed.  */
-
-void
-ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
-		       ffelexToken t)
-{
-  ffesttDimList 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;
-  new->previous->next = new;
-  new->lower = lower;
-  new->upper = upper;
-  new->t = t;
-}
-
-/* Convert list of dims into ffebld format.
-
-   ffesttDimList list;
-   ffeinfoRank rank;
-   ffebld array_size;
-   ffebld extents;
-   ffestt_dimlist_as_expr (list, &rank, &array_size, &extents);
-
-   The dims in the list are converted to a list of ITEMs; the rank of the
-   array, an expression representing the array size, a list of extent
-   expressions, and the list of ITEMs are returned.
-
-   If is_ugly_assumed, treat a final dimension with no lower bound
-   and an upper bound of 1 as a * bound.  */
-
-ffebld
-ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
-			ffebld *array_size, ffebld *extents,
-			bool is_ugly_assumed)
-{
-  ffesttDimList next;
-  ffebld expr;
-  ffebld as;
-  ffebld ex;			/* List of extents. */
-  ffebld ext;			/* Extent of a given dimension. */
-  ffebldListBottom bottom;
-  ffeinfoRank r;
-  ffeinfoKindtype nkt;
-  ffetargetIntegerDefault low;
-  ffetargetIntegerDefault high;
-  bool zero = FALSE;		/* Zero-size array. */
-  bool any = FALSE;
-  bool star = FALSE;		/* Adjustable array. */
-
-  assert (list != NULL);
-
-  r = 0;
-  ffebld_init_list (&expr, &bottom);
-  for (next = list->next; next != list; next = next->next)
-    {
-      ++r;
-      if (((next->lower == NULL)
-	   || (ffebld_op (next->lower) == FFEBLD_opCONTER))
-	  && (ffebld_op (next->upper) == FFEBLD_opCONTER))
-	{
-	  if (next->lower == NULL)
-	    low = 1;
-	  else
-	    low = ffebld_constant_integerdefault (ffebld_conter (next->lower));
-	  high = ffebld_constant_integerdefault (ffebld_conter (next->upper));
-	  if (low
-	      > high)
-	    zero = TRUE;
-	  if ((next->next == list)
-	      && is_ugly_assumed
-	      && (next->lower == NULL)
-	      && (high == 1)
-	      && (ffebld_conter_orig (next->upper) == NULL))
-	    {
-	      star = TRUE;
-	      ffebld_append_item (&bottom,
-				  ffebld_new_bounds (NULL, ffebld_new_star ()));
-	      continue;
-	    }
-	}
-      else if (((next->lower != NULL)
-		&& (ffebld_op (next->lower) == FFEBLD_opANY))
-	       || (ffebld_op (next->upper) == FFEBLD_opANY))
-	any = TRUE;
-      else if (ffebld_op (next->upper) == FFEBLD_opSTAR)
-	star = TRUE;
-      ffebld_append_item (&bottom,
-			  ffebld_new_bounds (next->lower, next->upper));
-    }
-  ffebld_end_list (&bottom);
-
-  if (zero)
-    {
-      as = ffebld_new_conter (ffebld_constant_new_integerdefault_val (0));
-      ffebld_set_info (as, ffeinfo_new
-		       (FFEINFO_basictypeINTEGER,
-			FFEINFO_kindtypeINTEGERDEFAULT,
-			0,
-			FFEINFO_kindENTITY,
-			FFEINFO_whereCONSTANT,
-			FFETARGET_charactersizeNONE));
-      ex = NULL;
-    }
-  else if (any)
-    {
-      as = ffebld_new_any ();
-      ffebld_set_info (as, ffeinfo_new_any ());
-      ex = ffebld_copy (as);
-    }
-  else if (star)
-    {
-      as = ffebld_new_star ();
-      ex = ffebld_new_star ();	/* ~~Should really be list as below. */
-    }
-  else
-    {
-      as = NULL;
-      ffebld_init_list (&ex, &bottom);
-      for (next = list->next; next != list; next = next->next)
-	{
-	  if ((next->lower == NULL)
-	      || ((ffebld_op (next->lower) == FFEBLD_opCONTER)
-		  && (ffebld_constant_integerdefault (ffebld_conter
-						      (next->lower)) == 1)))
-	    ext = ffebld_copy (next->upper);
-	  else
-	    {
-	      ext = ffebld_new_subtract (next->upper, next->lower);
-	      nkt
-		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
-					ffeinfo_kindtype (ffebld_info
-							  (next->lower)),
-					ffeinfo_kindtype (ffebld_info
-							  (next->upper)));
-	      ffebld_set_info (ext,
-			       ffeinfo_new (FFEINFO_basictypeINTEGER,
-					    nkt,
-					    0,
-					    FFEINFO_kindENTITY,
-					    ((ffebld_op (ffebld_left (ext))
-					      == FFEBLD_opCONTER)
-					     && (ffebld_op (ffebld_right
-							    (ext))
-						 == FFEBLD_opCONTER))
-					    ? FFEINFO_whereCONSTANT
-					    : FFEINFO_whereFLEETING,
-					    FFETARGET_charactersizeNONE));
-	      ffebld_set_left (ext,
-			       ffeexpr_convert_expr (ffebld_left (ext),
-						     next->t, ext, next->t,
-						     FFEEXPR_contextLET));
-	      ffebld_set_right (ext,
-				ffeexpr_convert_expr (ffebld_right (ext),
-						      next->t, ext,
-						      next->t,
-						      FFEEXPR_contextLET));
-	      ext = ffeexpr_collapse_subtract (ext, next->t);
-
-	      nkt
-		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
-					ffeinfo_kindtype (ffebld_info (ext)),
-					FFEINFO_kindtypeINTEGERDEFAULT);
-	      ext
-		= ffebld_new_add (ext,
-				  ffebld_new_conter
-				  (ffebld_constant_new_integerdefault_val
-				   (1)));
-	      ffebld_set_info (ffebld_right (ext), ffeinfo_new
-			       (FFEINFO_basictypeINTEGER,
-				FFEINFO_kindtypeINTEGERDEFAULT,
-				0,
-				FFEINFO_kindENTITY,
-				FFEINFO_whereCONSTANT,
-				FFETARGET_charactersizeNONE));
-	      ffebld_set_info (ext,
-			       ffeinfo_new (FFEINFO_basictypeINTEGER,
-					    nkt, 0, FFEINFO_kindENTITY,
-					    (ffebld_op (ffebld_left (ext))
-					     == FFEBLD_opCONTER)
-					    ? FFEINFO_whereCONSTANT
-					    : FFEINFO_whereFLEETING,
-					    FFETARGET_charactersizeNONE));
-	      ffebld_set_left (ext,
-			       ffeexpr_convert_expr (ffebld_left (ext),
-						     next->t, ext,
-						     next->t,
-						     FFEEXPR_contextLET));
-	      ffebld_set_right (ext,
-				ffeexpr_convert_expr (ffebld_right (ext),
-						      next->t, ext,
-						      next->t,
-						      FFEEXPR_contextLET));
-	      ext = ffeexpr_collapse_add (ext, next->t);
-	    }
-	  ffebld_append_item (&bottom, ext);
-	  if (as == NULL)
-	    as = ext;
-	  else
-	    {
-	      nkt
-		= ffeinfo_kindtype_max (FFEINFO_basictypeINTEGER,
-					ffeinfo_kindtype (ffebld_info (as)),
-				      ffeinfo_kindtype (ffebld_info (ext)));
-	      as = ffebld_new_multiply (as, ext);
-	      ffebld_set_info (as,
-			       ffeinfo_new (FFEINFO_basictypeINTEGER,
-					    nkt, 0, FFEINFO_kindENTITY,
-					    ((ffebld_op (ffebld_left (as))
-					      == FFEBLD_opCONTER)
-					     && (ffebld_op (ffebld_right
-							    (as))
-						 == FFEBLD_opCONTER))
-					    ? FFEINFO_whereCONSTANT
-					    : FFEINFO_whereFLEETING,
-					    FFETARGET_charactersizeNONE));
-	      ffebld_set_left (as,
-			       ffeexpr_convert_expr (ffebld_left (as),
-						     next->t, as, next->t,
-						     FFEEXPR_contextLET));
-	      ffebld_set_right (as,
-				ffeexpr_convert_expr (ffebld_right (as),
-						      next->t, as,
-						      next->t,
-						      FFEEXPR_contextLET));
-	      as = ffeexpr_collapse_multiply (as, next->t);
-	    }
-	}
-      ffebld_end_list (&bottom);
-      as = ffeexpr_convert (as, list->next->t, NULL,
-			    FFEINFO_basictypeINTEGER,
-			    FFEINFO_kindtypeINTEGERDEFAULT, 0,
-			    FFETARGET_charactersizeNONE,
-			    FFEEXPR_contextLET);
-    }
-
-  *rank = r;
-  *array_size = as;
-  *extents = ex;
-  return expr;
-}
-
-/* ffestt_dimlist_create -- Create new list of dims
-
-   ffesttDimList list;
-   list = ffestt_dimlist_create();
-
-   The list is allocated out of the scratch pool.  */
-
-ffesttDimList
-ffestt_dimlist_create (void)
-{
-  ffesttDimList 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;
-  new->upper = NULL;
-  return new;
-}
-
-/* ffestt_dimlist_kill -- Kill list of dims
-
-   ffesttDimList list;
-   ffestt_dimlist_kill(list);
-
-   The tokens on the list are killed.  */
-
-void
-ffestt_dimlist_kill (ffesttDimList list)
-{
-  ffesttDimList next;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      ffelex_token_kill (next->t);
-    }
-}
-
-/* Determine type of list of dimensions.
-
-   Return KNOWN for all-constant bounds, ADJUSTABLE for constant
-   and variable but no * bounds, ASSUMED for constant and * but
-   not variable bounds, ADJUSTABLEASSUMED for constant and variable
-   and * bounds.
-
-   If is_ugly_assumed, treat a final dimension with no lower bound
-   and an upper bound of 1 as a * bound.  */
-
-ffestpDimtype
-ffestt_dimlist_type (ffesttDimList list, bool is_ugly_assumed)
-{
-  ffesttDimList next;
-  ffestpDimtype type;
-
-  if (list == NULL)
-    return FFESTP_dimtypeNONE;
-
-  type = FFESTP_dimtypeKNOWN;
-  for (next = list->next; next != list; next = next->next)
-    {
-      bool ugly_assumed = FALSE;
-
-      if ((next->next == list)
-	  && is_ugly_assumed
-	  && (next->lower == NULL)
-	  && (next->upper != NULL)
-	  && (ffebld_op (next->upper) == FFEBLD_opCONTER)
-	  && (ffebld_constant_integerdefault (ffebld_conter (next->upper))
-	      == 1)
-	  && (ffebld_conter_orig (next->upper) == NULL))
-	ugly_assumed = TRUE;
-
-      if (next->lower != NULL)
-	{
-	  if (ffebld_op (next->lower) != FFEBLD_opCONTER)
-	    {
-	      if (type == FFESTP_dimtypeASSUMED)
-		type = FFESTP_dimtypeADJUSTABLEASSUMED;
-	      else
-		type = FFESTP_dimtypeADJUSTABLE;
-	    }
-	}
-      if (next->upper != NULL)
-	{
-	  if (ugly_assumed
-	      || (ffebld_op (next->upper) == FFEBLD_opSTAR))
-	    {
-	      if (type == FFESTP_dimtypeADJUSTABLE)
-		type = FFESTP_dimtypeADJUSTABLEASSUMED;
-	      else
-		type = FFESTP_dimtypeASSUMED;
-	    }
-	  else if (ffebld_op (next->upper) != FFEBLD_opCONTER)
-	    type = FFESTP_dimtypeADJUSTABLE;
-	}
-    }
-
-  return type;
-}
-
-/* ffestt_exprlist_append -- Append expr to list of exprs
-
-   ffesttExprList list;
-   ffelexToken t;
-   ffestt_exprlist_append(list,expr,t);
-
-   list must have already been created by ffestt_exprlist_create.  The
-   list is allocated out of the scratch pool.  The token is consumed.  */
-
-void
-ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t)
-{
-  ffesttExprList 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;
-  new->previous->next = new;
-  new->expr = expr;
-  new->t = t;
-}
-
-/* ffestt_exprlist_create -- Create new list of exprs
-
-   ffesttExprList list;
-   list = ffestt_exprlist_create();
-
-   The list is allocated out of the scratch pool.  */
-
-ffesttExprList
-ffestt_exprlist_create (void)
-{
-  ffesttExprList 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;
-  return new;
-}
-
-/* ffestt_exprlist_drive -- Drive list of token pairs into function
-
-   ffesttExprList list;
-   void fn(ffebld expr,ffelexToken t);
-   ffestt_exprlist_drive(list,fn);
-
-   The expr/token pairs in the list are passed to the function one pair
-   at a time.  */
-
-void
-ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken))
-{
-  ffesttExprList next;
-
-  if (list == NULL)
-    return;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      (*fn) (next->expr, next->t);
-    }
-}
-
-/* ffestt_exprlist_kill -- Kill list of exprs
-
-   ffesttExprList list;
-   ffestt_exprlist_kill(list);
-
-   The tokens on the list are killed.
-
-   02-Mar-90  JCB  1.1
-      Don't kill the list itself or change it, since it will be trashed when
-      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
-
-void
-ffestt_exprlist_kill (ffesttExprList list)
-{
-  ffesttExprList next;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      ffelex_token_kill (next->t);
-    }
-}
-
-/* ffestt_formatlist_append -- Append null format to list of formats
-
-   ffesttFormatList list, new;
-   new = ffestt_formatlist_append(list);
-
-   list must have already been created by ffestt_formatlist_create.  The
-   new item is allocated out of the scratch pool.  The caller must initialize
-   it appropriately.  */
-
-ffesttFormatList
-ffestt_formatlist_append (ffesttFormatList list)
-{
-  ffesttFormatList 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;
-  new->previous->next = new;
-  return new;
-}
-
-/* ffestt_formatlist_create -- Create new list of formats
-
-   ffesttFormatList list;
-   list = ffestt_formatlist_create(NULL);
-
-   The list is allocated out of the scratch pool.  */
-
-ffesttFormatList
-ffestt_formatlist_create (ffesttFormatList parent, ffelexToken t)
-{
-  ffesttFormatList 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;
-  new->u.root.parent = parent;
-  return new;
-}
-
-/* ffestt_formatlist_kill -- Kill tokens on list of formats
-
-   ffesttFormatList list;
-   ffestt_formatlist_kill(list);
-
-   The tokens on the list are killed.  */
-
-void
-ffestt_formatlist_kill (ffesttFormatList list)
-{
-  ffesttFormatList next;
-
-  /* Always kill from the very top on down. */
-
-  while (list->u.root.parent != NULL)
-    list = list->u.root.parent->next;
-
-  /* Kill first token for this list. */
-
-  if (list->t != NULL)
-    ffelex_token_kill (list->t);
-
-  /* Kill each item in this list. */
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      ffelex_token_kill (next->t);
-      switch (next->type)
-	{
-	case FFESTP_formattypeI:
-	case FFESTP_formattypeB:
-	case FFESTP_formattypeO:
-	case FFESTP_formattypeZ:
-	case FFESTP_formattypeF:
-	case FFESTP_formattypeE:
-	case FFESTP_formattypeEN:
-	case FFESTP_formattypeG:
-	case FFESTP_formattypeL:
-	case FFESTP_formattypeA:
-	case FFESTP_formattypeD:
-	  if (next->u.R1005.R1004.t != NULL)
-	    ffelex_token_kill (next->u.R1005.R1004.t);
-	  if (next->u.R1005.R1006.t != NULL)
-	    ffelex_token_kill (next->u.R1005.R1006.t);
-	  if (next->u.R1005.R1007_or_R1008.t != NULL)
-	    ffelex_token_kill (next->u.R1005.R1007_or_R1008.t);
-	  if (next->u.R1005.R1009.t != NULL)
-	    ffelex_token_kill (next->u.R1005.R1009.t);
-	  break;
-
-	case FFESTP_formattypeQ:
-	case FFESTP_formattypeDOLLAR:
-	case FFESTP_formattypeP:
-	case FFESTP_formattypeT:
-	case FFESTP_formattypeTL:
-	case FFESTP_formattypeTR:
-	case FFESTP_formattypeX:
-	case FFESTP_formattypeS:
-	case FFESTP_formattypeSP:
-	case FFESTP_formattypeSS:
-	case FFESTP_formattypeBN:
-	case FFESTP_formattypeBZ:
-	case FFESTP_formattypeSLASH:
-	case FFESTP_formattypeCOLON:
-	  if (next->u.R1010.val.t != NULL)
-	    ffelex_token_kill (next->u.R1010.val.t);
-	  break;
-
-	case FFESTP_formattypeR1016:
-	  break;		/* Nothing more to do. */
-
-	case FFESTP_formattypeFORMAT:
-	  if (next->u.R1003D.R1004.t != NULL)
-	    ffelex_token_kill (next->u.R1003D.R1004.t);
-	  next->u.R1003D.format->u.root.parent = NULL;	/* Parent already dying. */
-	  ffestt_formatlist_kill (next->u.R1003D.format);
-	  break;
-
-	default:
-	  assert (FALSE);
-	}
-    }
-}
-
-/* ffestt_implist_append -- Append token pair to list of token pairs
-
-   ffesttImpList list;
-   ffelexToken t;
-   ffestt_implist_append(list,start_token,end_token);
-
-   list must have already been created by ffestt_implist_create.  The
-   list is allocated out of the scratch pool.  The tokens are consumed.	 */
-
-void
-ffestt_implist_append (ffesttImpList list, ffelexToken first, ffelexToken last)
-{
-  ffesttImpList 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;
-  new->previous->next = new;
-  new->first = first;
-  new->last = last;
-}
-
-/* ffestt_implist_create -- Create new list of token pairs
-
-   ffesttImpList list;
-   list = ffestt_implist_create();
-
-   The list is allocated out of the scratch pool.  */
-
-ffesttImpList
-ffestt_implist_create (void)
-{
-  ffesttImpList 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;
-  return new;
-}
-
-/* ffestt_implist_drive -- Drive list of token pairs into function
-
-   ffesttImpList list;
-   void fn(ffelexToken first,ffelexToken last);
-   ffestt_implist_drive(list,fn);
-
-   The token pairs in the list are passed to the function one pair at a time.  */
-
-void
-ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken))
-{
-  ffesttImpList next;
-
-  if (list == NULL)
-    return;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      (*fn) (next->first, next->last);
-    }
-}
-
-/* ffestt_implist_kill -- Kill list of token pairs
-
-   ffesttImpList list;
-   ffestt_implist_kill(list);
-
-   The tokens on the list are killed.  */
-
-void
-ffestt_implist_kill (ffesttImpList list)
-{
-  ffesttImpList next;
-
-  for (next = list->next; next != list; next = next->next)
-    {
-      ffelex_token_kill (next->first);
-      if (next->last != NULL)
-	ffelex_token_kill (next->last);
-    }
-}
-
-/* ffestt_tokenlist_append -- Append token to list of tokens
-
-   ffesttTokenList tl;
-   ffelexToken t;
-   ffestt_tokenlist_append(tl,t);
-
-   tl must have already been created by ffestt_tokenlist_create.  The
-   list is allocated out of the scratch pool.  The token is consumed.  */
-
-void
-ffestt_tokenlist_append (ffesttTokenList tl, ffelexToken t)
-{
-  ffesttTokenItem 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;
-  ti->previous->next = ti;
-  ti->t = t;
-  ++tl->count;
-}
-
-/* ffestt_tokenlist_create -- Create new list of tokens
-
-   ffesttTokenList tl;
-   tl = ffestt_tokenlist_create();
-
-   The list is allocated out of the scratch pool.  */
-
-ffesttTokenList
-ffestt_tokenlist_create (void)
-{
-  ffesttTokenList 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;
-}
-
-/* ffestt_tokenlist_drive -- Drive list of tokens
-
-   ffesttTokenList tl;
-   void fn(ffelexToken t);
-   ffestt_tokenlist_drive(tl,fn);
-
-   The tokens in the list are passed to the given function.  */
-
-void
-ffestt_tokenlist_drive (ffesttTokenList tl, void (*fn) (ffelexToken))
-{
-  ffesttTokenItem ti;
-
-  if (tl == NULL)
-    return;
-
-  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
-    {
-      (*fn) (ti->t);
-    }
-}
-
-/* ffestt_tokenlist_handle -- Handle list of tokens
-
-   ffesttTokenList tl;
-   ffelexHandler handler;
-   handler = ffestt_tokenlist_handle(tl,handler);
-
-   The tokens in the list are passed to the handler(s).	 */
-
-ffelexHandler
-ffestt_tokenlist_handle (ffesttTokenList tl, ffelexHandler handler)
-{
-  ffesttTokenItem ti;
-
-  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
-    handler = (ffelexHandler) (*handler) (ti->t);
-
-  return (ffelexHandler) handler;
-}
-
-/* ffestt_tokenlist_kill -- Kill list of tokens
-
-   ffesttTokenList tl;
-   ffestt_tokenlist_kill(tl);
-
-   The tokens on the list are killed.
-
-   02-Mar-90  JCB  1.1
-      Don't kill the list itself or change it, since it will be trashed when
-      ffesta_scratch_pool is killed anyway, so kill only the lex tokens.  */
-
-void
-ffestt_tokenlist_kill (ffesttTokenList tl)
-{
-  ffesttTokenItem ti;
-
-  for (ti = tl->first; ti != (ffesttTokenItem) &tl->first; ti = ti->next)
-    {
-      ffelex_token_kill (ti->t);
-    }
-}
diff --git a/gcc/f/stt.h b/gcc/f/stt.h
deleted file mode 100644
index 56543d0..0000000
--- a/gcc/f/stt.h
+++ /dev/null
@@ -1,212 +0,0 @@
-/* stt.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stt.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STT_H
-#define GCC_F_STT_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-typedef struct _ffest_case_list_ *ffesttCaseList;
-typedef struct _ffest_dim_list_ *ffesttDimList;
-typedef struct _ffest_expr_list_ *ffesttExprList;
-typedef struct _ffest_format_value_ ffesttFormatValue;
-typedef struct _ffest_format_list_ *ffesttFormatList;
-typedef struct _ffest_imp_list_ *ffesttImpList;
-typedef struct _ffest_token_item_ *ffesttTokenItem;
-typedef struct _ffest_token_list_ *ffesttTokenList;
-
-/* Include files needed by this one. */
-
-#include "top.h"
-#include "bld.h"
-#include "info.h"
-#include "lex.h"
-#include "stp.h"
-
-/* Structure definitions. */
-
-struct _ffest_case_list_
-  {
-    ffesttCaseList next;
-    ffesttCaseList previous;
-    ffelexToken t;
-    ffebld expr1;
-    ffebld expr2;
-    bool range;			/* TRUE if "[expr1]:[expr2]", FALSE if
-				   "expr1". */
-  };
-
-struct _ffest_dim_list_
-  {
-    ffesttDimList next;
-    ffesttDimList previous;
-    ffelexToken t;
-    ffebld lower;
-    ffebld upper;
-  };
-
-struct _ffest_expr_list_
-  {
-    ffesttExprList next;
-    ffesttExprList previous;
-    ffelexToken t;
-    ffebld expr;
-  };
-
-struct _ffest_token_item_
-  {
-    ffesttTokenItem next;
-    ffesttTokenItem previous;
-    ffelexToken t;
-  };
-
-struct _ffest_token_list_
-  {
-    ffesttTokenItem first;
-    ffesttTokenItem last;
-    int count;			/* Number of tokens in list. */
-  };
-
-struct _ffest_format_value_
-  {
-    bool present;		/* TRUE if value supplied (needed for
-				   optional values only). */
-    bool rtexpr;		/* FALSE if constant value here, TRUE if
-				   run-time expr (VXT). */
-    ffelexToken t;		/* The first token, or perhaps just prior if
-				   can't get it. */
-    union
-      {
-	ffeUnionLongPtr unused;	/* Make sure all the info gets copied. */
-	long signed_val;	/* for R1011. */
-	unsigned long unsigned_val;	/* For other constant values. */
-	ffebld expr;		/* For run-time expression (VXT). */
-      }
-    u;
-  };
-
-struct _ffest_format_list_
-  {
-    ffesttFormatList next;
-    ffesttFormatList previous;
-    ffelexToken t;		/* The NAME, CHARACTER, or HOLLERITH token. */
-    ffestpFormatType type;
-    union ffest_format_
-      {
-	struct
-	  {
-	    ffesttFormatValue R1004;	/* r, the repeat count. */
-	    ffesttFormatValue R1006;	/* w, the field width. */
-	    ffesttFormatValue R1007_or_R1008;	/* m, the minimum number of
-						   digits; d, the number of
-						   decimal digits. */
-	    ffesttFormatValue R1009;	/* e, the number of exponent digits. */
-	  }
-	R1005;			/* data-edit-desc. */
-	struct
-	  {
-	    ffesttFormatValue val;	/* r, the repeat count; k, the
-					   precision magnitude adjustment; n,
-					   the column number (abs or rel). */
-	  }
-	R1010;			/* control-edit-desc. */
-	struct
-	  {
-	    ffesttFormatValue R1004;	/* r, the repeat count. */
-	    ffesttFormatList format;	/* the parenthesized
-					   format-item-list. */
-	  }
-	R1003D;			/* format-item of for [r](format-item-list). */
-	struct
-	  {
-	    ffesttFormatList parent;	/* NULL if outer list, else parent
-					   item. */
-	  }
-	root;			/* FFESTP_formattypeNone case. */
-      }
-    u;
-  };
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-void ffestt_caselist_append (ffesttCaseList list, bool range, ffebld case1,
-			     ffebld case2, ffelexToken t);
-ffesttCaseList ffestt_caselist_create (void);
-void ffestt_caselist_kill (ffesttCaseList list);
-void ffestt_dimlist_append (ffesttDimList list, ffebld lower, ffebld upper,
-			    ffelexToken t);
-ffebld ffestt_dimlist_as_expr (ffesttDimList list, ffeinfoRank *rank,
-			       ffebld *array_size, ffebld *extents,
-			       bool is_ugly_assumed);
-ffesttDimList ffestt_dimlist_create (void);
-void ffestt_dimlist_kill (ffesttDimList list);
-ffestpDimtype ffestt_dimlist_type (ffesttDimList dims, bool is_ugly_assumed);
-void ffestt_exprlist_append (ffesttExprList list, ffebld expr, ffelexToken t);
-ffesttExprList ffestt_exprlist_create (void);
-void ffestt_exprlist_drive (ffesttExprList list, void (*fn) (ffebld, ffelexToken));
-void ffestt_exprlist_kill (ffesttExprList list);
-ffesttFormatList ffestt_formatlist_append (ffesttFormatList list);
-ffesttFormatList ffestt_formatlist_create (ffesttFormatList parent,
-					   ffelexToken t);
-void ffestt_formatlist_kill (ffesttFormatList list);
-void ffestt_implist_append (ffesttImpList list, ffelexToken first,
-			    ffelexToken last);
-ffesttImpList ffestt_implist_create (void);
-void ffestt_implist_drive (ffesttImpList list, void (*fn) (ffelexToken, ffelexToken));
-void ffestt_implist_kill (ffesttImpList list);
-void ffestt_tokenlist_append (ffesttTokenList list, ffelexToken t);
-ffesttTokenList ffestt_tokenlist_create (void);
-void ffestt_tokenlist_drive (ffesttTokenList list, void (*fn) (ffelexToken));
-ffelexHandler ffestt_tokenlist_handle (ffesttTokenList list,
-				       ffelexHandler handler);
-void ffestt_tokenlist_kill (ffesttTokenList list);
-
-/* Define macros. */
-
-#define ffestt_init_0()
-#define ffestt_init_1()
-#define ffestt_init_2()
-#define ffestt_init_3()
-#define ffestt_init_4()
-#define ffestt_terminate_0()
-#define ffestt_terminate_1()
-#define ffestt_terminate_2()
-#define ffestt_terminate_3()
-#define ffestt_terminate_4()
-#define ffestt_tokenlist_count(tl) ((tl)->count)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STT_H */
diff --git a/gcc/f/stu.c b/gcc/f/stu.c
deleted file mode 100644
index 1d58731..0000000
--- a/gcc/f/stu.c
+++ /dev/null
@@ -1,1162 +0,0 @@
-/* stu.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 files. */
-
-#include "proj.h"
-#include "bld.h"
-#include "com.h"
-#include "equiv.h"
-#include "global.h"
-#include "info.h"
-#include "implic.h"
-#include "intrin.h"
-#include "stu.h"
-#include "storag.h"
-#include "sta.h"
-#include "symbol.h"
-#include "target.h"
-
-/* Externals defined here. */
-
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-static void ffestu_list_exec_transition_ (ffebld list);
-static bool ffestu_symter_end_transition_ (ffebld expr);
-static bool ffestu_symter_exec_transition_ (ffebld expr);
-static bool ffestu_dummies_transition_ (ffesymbol (*symfunc) (ffesymbol),
-					ffebld list);
-
-/* Internal macros. */
-
-#define ffestu_equiv_(s) (((ffesymbol_equiv (s) == NULL)		      \
-  || (ffeequiv_common (ffesymbol_equiv (s)) == NULL)) ? FFEINFO_whereLOCAL    \
-  : FFEINFO_whereCOMMON)
-
-/* Update symbol info just before end of unit.  */
-
-ffesymbol
-ffestu_sym_end_transition (ffesymbol s)
-{
-  ffeinfoKind skd;
-  ffeinfoWhere swh;
-  ffeinfoKind nkd;
-  ffeinfoWhere nwh;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffesymbolState ss;
-  ffesymbolState ns;
-  bool needs_type = TRUE;	/* Implicit type assignment might be
-				   necessary. */
-
-  assert (s != NULL);
-  ss = ffesymbol_state (s);
-  sa = ffesymbol_attrs (s);
-  skd = ffesymbol_kind (s);
-  swh = ffesymbol_where (s);
-
-  switch (ss)
-    {
-    case FFESYMBOL_stateUNCERTAIN:
-      if ((swh == FFEINFO_whereDUMMY)
-	  && (ffesymbol_numentries (s) == 0))
-	{			/* Not actually in any dummy list! */
-	  ffesymbol_error (s, ffesta_tokens[0]);
-	  return s;
-	}
-      else if (((swh == FFEINFO_whereLOCAL)
-		|| (swh == FFEINFO_whereNONE))
-	       && (skd == FFEINFO_kindENTITY)
-	       && ffestu_symter_end_transition_ (ffesymbol_dims (s)))
-	{			/* Bad dimension expressions. */
-	  ffesymbol_error (s, NULL);
-	  return s;
-	}
-      break;
-
-    case FFESYMBOL_stateUNDERSTOOD:
-      if ((swh == FFEINFO_whereLOCAL)
-	  && ((skd == FFEINFO_kindFUNCTION)
-	      || (skd == FFEINFO_kindSUBROUTINE)))
-	{
-	  int n_args;
-	  ffebld list;
-	  ffebld item;
-	  ffeglobalArgSummary as;
-	  ffeinfoBasictype bt;
-	  ffeinfoKindtype kt;
-	  bool array;
-	  const char *name = NULL;
-
-	  ffestu_dummies_transition_ (ffecom_sym_end_transition,
-				      ffesymbol_dummyargs (s));
-
-	  n_args = ffebld_list_length (ffesymbol_dummyargs (s));
-	  ffeglobal_proc_def_nargs (s, n_args);
-	  for (list = ffesymbol_dummyargs (s), n_args = 0;
-	       list != NULL;
-	       list = ffebld_trail (list), ++n_args)
-	    {
-	      item = ffebld_head (list);
-	      array = FALSE;
-	      if (item != NULL)
-		{
-		  bt = ffeinfo_basictype (ffebld_info (item));
-		  kt = ffeinfo_kindtype (ffebld_info (item));
-		  array = (ffeinfo_rank (ffebld_info (item)) > 0);
-		  switch (ffebld_op (item))
-		    {
-		    case FFEBLD_opSTAR:
-		      as = FFEGLOBAL_argsummaryALTRTN;
-		      break;
-
-		    case FFEBLD_opSYMTER:
-		      name = ffesymbol_text (ffebld_symter (item));
-		      as = FFEGLOBAL_argsummaryNONE;
-
-		      switch (ffeinfo_kind (ffebld_info (item)))
-			{
-			case FFEINFO_kindFUNCTION:
-			  as = FFEGLOBAL_argsummaryFUNC;
-			  break;
-
-			case FFEINFO_kindSUBROUTINE:
-			  as = FFEGLOBAL_argsummarySUBR;
-			  break;
-
-			case FFEINFO_kindNONE:
-			  as = FFEGLOBAL_argsummaryPROC;
-			  break;
-
-			default:
-			  break;
-			}
-
-		      if (as != FFEGLOBAL_argsummaryNONE)
-			break;
-
-		      /* Fall through.  */
-		    default:
-		      if (bt == FFEINFO_basictypeCHARACTER)
-			as = FFEGLOBAL_argsummaryDESCR;
-		      else
-			as = FFEGLOBAL_argsummaryREF;
-		      break;
-		    }
-		}
-	      else
-		{
-		  as = FFEGLOBAL_argsummaryNONE;
-		  bt = FFEINFO_basictypeNONE;
-		  kt = FFEINFO_kindtypeNONE;
-		}
-	      ffeglobal_proc_def_arg (s, n_args, name, as, bt, kt, array);
-	    }
-	}
-      else if (swh == FFEINFO_whereDUMMY)
-	{
-	  if (ffesymbol_numentries (s) == 0)
-	    {			/* Not actually in any dummy list! */
-	      ffesymbol_error (s, ffesta_tokens[0]);
-	      return s;
-	    }
-	  if (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
-	    {			/* Bad dimension expressions. */
-	      ffesymbol_error (s, NULL);
-	      return s;
-	    }
-	}
-      else if ((swh == FFEINFO_whereLOCAL)
-	       && ffestu_symter_end_transition_ (ffesymbol_dims (s)))
-	{			/* Bad dimension expressions. */
-	  ffesymbol_error (s, NULL);
-	  return s;
-	}
-
-      ffestorag_end_layout (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-      return s;
-
-    default:
-      assert ("bad status" == NULL);
-      return s;
-    }
-
-  ns = FFESYMBOL_stateUNDERSTOOD;
-  na = sa = ffesymbol_attrs (s);
-
-  assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		   | FFESYMBOL_attrsADJUSTABLE
-		   | FFESYMBOL_attrsANYLEN
-		   | FFESYMBOL_attrsARRAY
-		   | FFESYMBOL_attrsDUMMY
-		   | FFESYMBOL_attrsEXTERNAL
-		   | FFESYMBOL_attrsSFARG
-		   | FFESYMBOL_attrsTYPE)));
-
-  nkd = skd;
-  nwh = swh;
-
-  /* Figure out what kind of object we've got based on previous declarations
-     of or references to the object. */
-
-  if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsACTUALARG
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	nwh = FFEINFO_whereGLOBAL;
-      else
-	/* Not TYPE. */
-	{
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    {			/* Not TYPE. */
-	      ns = FFESYMBOL_stateUNCERTAIN;	/* FUNCTION/SUBROUTINE. */
-	      needs_type = FALSE;	/* Don't assign type to SUBROUTINE! */
-	    }
-	  else if (sa & FFESYMBOL_attrsACTUALARG)
-	    {			/* Not DUMMY or TYPE. */
-	      ns = FFESYMBOL_stateUNCERTAIN;	/* FUNCTION/SUBROUTINE. */
-	      needs_type = FALSE;	/* Don't assign type to SUBROUTINE! */
-	    }
-	  else
-	    /* Not ACTUALARG, DUMMY, or TYPE. */
-	    {			/* This is an assumption, essentially. */
-	      nkd = FFEINFO_kindBLOCKDATA;
-	      nwh = FFEINFO_whereGLOBAL;
-	      needs_type = FALSE;
-	    }
-	}
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      /* Honestly, this appears to be a guess.  I can't find anyplace in the
-	 standard that makes clear whether this unreferenced dummy argument
-	 is an ENTITY or a FUNCTION.  And yet, for the f2c interface, picking
-	 one is critical for CHARACTER entities because it determines whether
-	 to expect an additional argument specifying the length of an ENTITY
-	 that is not expected (or needed) for a FUNCTION.  HOWEVER, F90 makes
-	 this guess a correct one, and it does seem that the Section 18 Notes
-	 in Appendix B of F77 make it clear the F77 standard at least
-	 intended to make this guess correct as well, so this seems ok.  */
-
-      nkd = FFEINFO_kindENTITY;
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (ffestu_symter_end_transition_ (ffesymbol_dims (s)))
-	{
-	  ffesymbol_error (s, NULL);
-	  return s;
-	}
-
-      if (sa & FFESYMBOL_attrsADJUSTABLE)
-	{			/* Not actually in any dummy list! */
-	  if (ffe_is_pedantic ()
-	      /* xgettext:no-c-format */
-	      && ffebad_start_msg ("Local adjustable symbol `%A' at %0",
-				   FFEBAD_severityPEDANTIC))
-	    {
-	      ffebad_string (ffesymbol_text (s));
-	      ffebad_here (0, ffesymbol_where_line (s),
-			   ffesymbol_where_column (s));
-	      ffebad_finish ();
-	    }
-	}
-      nwh = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      nwh = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsSFARG)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsTYPE
-		       | FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG)));
-
-      if (sa & FFESYMBOL_attrsANYLEN)
-	{			/* Can't touch this. */
-	  ffesymbol_signal_change (s);
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_resolve_intrin (s);
-	  s = ffecom_sym_learned (s);
-	  ffesymbol_reference (s, NULL, FALSE);
-	  ffestorag_end_layout (s);
-	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-	  return s;
-	}
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = FFEINFO_whereLOCAL;
-    }
-  else
-    assert ("unexpected attribute set" == NULL);
-
-  /* Now see what we've got for a new object: NONE means a new error cropped
-     up; ANY means an old error to be ignored; otherwise, everything's ok,
-     update the object (symbol) and continue on. */
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, ffesta_tokens[0]);
-  else if (!(na & FFESYMBOL_attrsANY))
-    {
-      ffesymbol_signal_change (s);
-      ffesymbol_set_attrs (s, na);	/* Establish new info. */
-      ffesymbol_set_state (s, ns);
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       nkd,
-				       nwh,
-				       ffesymbol_size (s)));
-      if (needs_type && !ffeimplic_establish_symbol (s))
-	ffesymbol_error (s, ffesta_tokens[0]);
-      else
-	ffesymbol_resolve_intrin (s);
-      s = ffecom_sym_learned (s);
-      ffesymbol_reference (s, NULL, FALSE);
-      ffestorag_end_layout (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* ffestu_sym_exec_transition -- Update symbol just before first exec stmt
-
-   ffesymbol s;
-   ffestu_sym_exec_transition(s);  */
-
-ffesymbol
-ffestu_sym_exec_transition (ffesymbol s)
-{
-  ffeinfoKind skd;
-  ffeinfoWhere swh;
-  ffeinfoKind nkd;
-  ffeinfoWhere nwh;
-  ffesymbolAttrs sa;
-  ffesymbolAttrs na;
-  ffesymbolState ss;
-  ffesymbolState ns;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-  bool needs_type = TRUE;	/* Implicit type assignment might be
-				   necessary. */
-  bool resolve_intrin = TRUE;	/* Might need to resolve intrinsic. */
-
-  assert (s != NULL);
-
-  sa = ffesymbol_attrs (s);
-  skd = ffesymbol_kind (s);
-  swh = ffesymbol_where (s);
-  ss = ffesymbol_state (s);
-
-  switch (ss)
-    {
-    case FFESYMBOL_stateNONE:
-      return s;			/* Assume caller will handle it. */
-
-    case FFESYMBOL_stateSEEN:
-      break;
-
-    case FFESYMBOL_stateUNCERTAIN:
-      ffestorag_exec_layout (s);
-      return s;			/* Already processed this one, or not
-				   necessary. */
-
-    case FFESYMBOL_stateUNDERSTOOD:
-      if (skd == FFEINFO_kindNAMELIST)
-	{
-	  ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
-	  ffestu_list_exec_transition_ (ffesymbol_namelist (s));
-	}
-      else if ((swh == FFEINFO_whereLOCAL)
-	       && ((skd == FFEINFO_kindFUNCTION)
-		   || (skd == FFEINFO_kindSUBROUTINE)))
-	{
-	  ffestu_dummies_transition_ (ffecom_sym_exec_transition,
-				      ffesymbol_dummyargs (s));
-	  if ((skd == FFEINFO_kindFUNCTION)
-	      && !ffeimplic_establish_symbol (s))
-	    ffesymbol_error (s, ffesta_tokens[0]);
-	}
-
-      ffesymbol_reference (s, NULL, FALSE);
-      ffestorag_exec_layout (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-      return s;
-
-    default:
-      assert ("bad status" == NULL);
-      return s;
-    }
-
-  ns = FFESYMBOL_stateUNDERSTOOD;	/* Only a few UNCERTAIN exceptions. */
-
-  na = sa;
-  nkd = skd;
-  nwh = swh;
-
-  assert (!(sa & FFESYMBOL_attrsANY));
-
-  if (sa & FFESYMBOL_attrsCOMMON)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsINIT
-		       | FFESYMBOL_attrsNAMELIST
-		       | FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = FFEINFO_whereCOMMON;
-    }
-  else if (sa & FFESYMBOL_attrsRESULT)
-    {				/* Result variable for function. */
-      assert (!(sa & ~(FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsRESULT
-		       | FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = FFEINFO_whereRESULT;
-    }
-  else if (sa & FFESYMBOL_attrsSFUNC)
-    {				/* Statement function. */
-      assert (!(sa & ~(FFESYMBOL_attrsSFUNC
-		       | FFESYMBOL_attrsTYPE)));
-
-      nkd = FFEINFO_kindFUNCTION;
-      nwh = FFEINFO_whereCONSTANT;
-    }
-  else if (sa & FFESYMBOL_attrsEXTERNAL)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsTYPE)));
-
-      if (sa & FFESYMBOL_attrsTYPE)
-	{
-	  nkd = FFEINFO_kindFUNCTION;
-
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    nwh = FFEINFO_whereDUMMY;
-	  else
-	    {
-	      if (ffesta_is_entry_valid)
-		{
-		  nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL. */
-		  ns = FFESYMBOL_stateUNCERTAIN;
-		}
-	      else
-		nwh = FFEINFO_whereGLOBAL;
-	    }
-	}
-      else
-	/* No TYPE. */
-	{
-	  nkd = FFEINFO_kindNONE;	/* FUNCTION, SUBROUTINE, BLOCKDATA. */
-	  needs_type = FALSE;	/* Only gets type if FUNCTION. */
-	  ns = FFESYMBOL_stateUNCERTAIN;
-
-	  if (sa & FFESYMBOL_attrsDUMMY)
-	    nwh = FFEINFO_whereDUMMY;	/* Not BLOCKDATA. */
-	  else
-	    {
-	      if (ffesta_is_entry_valid)
-		nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL. */
-	      else
-		nwh = FFEINFO_whereGLOBAL;
-	    }
-	}
-    }
-  else if (sa & FFESYMBOL_attrsDUMMY)
-    {
-      assert (!(sa & FFESYMBOL_attrsEXTERNAL));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE	/* Possible. */
-		       | FFESYMBOL_attrsADJUSTS	/* Possible. */
-		       | FFESYMBOL_attrsANYLEN	/* Possible. */
-		       | FFESYMBOL_attrsANYSIZE	/* Possible. */
-		       | FFESYMBOL_attrsARRAY	/* Possible. */
-		       | FFESYMBOL_attrsDUMMY	/* Have it. */
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsSFARG	/* Possible. */
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nwh = FFEINFO_whereDUMMY;
-
-      if (ffestu_symter_exec_transition_ (ffesymbol_dims (s)))
-	na = FFESYMBOL_attrsetNONE;
-
-      if (sa & (FFESYMBOL_attrsADJUSTS
-		| FFESYMBOL_attrsARRAY
-		| FFESYMBOL_attrsANYLEN
-		| FFESYMBOL_attrsNAMELIST
-		| FFESYMBOL_attrsSFARG))
-	nkd = FFEINFO_kindENTITY;
-      else if (sa & FFESYMBOL_attrsDUMMY)	/* Still okay. */
-	{
-	  if (!(sa & FFESYMBOL_attrsTYPE))
-	    needs_type = FALSE;	/* Don't assign type to SUBROUTINE! */
-	  nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION, SUBROUTINE. */
-	  ns = FFESYMBOL_stateUNCERTAIN;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsADJUSTS)
-    {				/* Must be DUMMY or COMMON at some point. */
-      assert (!(sa & (FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsDUMMY)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS	/* Have it. */
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEQUIV	/* Possible. */
-		       | FFESYMBOL_attrsINIT	/* Possible. */
-		       | FFESYMBOL_attrsNAMELIST	/* Possible. */
-		       | FFESYMBOL_attrsSFARG	/* Possible. */
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nkd = FFEINFO_kindENTITY;
-
-      if (sa & FFESYMBOL_attrsEQUIV)
-	{
-	  if ((ffesymbol_equiv (s) == NULL)
-	      || (ffeequiv_common (ffesymbol_equiv (s)) == NULL))
-	    na = FFESYMBOL_attrsetNONE;	/* Not equiv'd into COMMON. */
-	  else
-	    nwh = FFEINFO_whereCOMMON;
-	}
-      else if (!ffesta_is_entry_valid
-	       || (sa & (FFESYMBOL_attrsINIT
-			 | FFESYMBOL_attrsNAMELIST)))
-	na = FFESYMBOL_attrsetNONE;
-      else
-	nwh = FFEINFO_whereDUMMY;
-    }
-  else if (sa & FFESYMBOL_attrsSAVE)
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsINIT
-		       | FFESYMBOL_attrsNAMELIST
-		       | FFESYMBOL_attrsSAVE
-		       | FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsTYPE)));
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsEQUIV)
-    {
-      assert (!(sa & FFESYMBOL_attrsCOMMON));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS	/* Possible. */
-		       | FFESYMBOL_attrsARRAY	/* Possible. */
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsEQUIV	/* Have it. */
-		       | FFESYMBOL_attrsINIT	/* Possible. */
-		       | FFESYMBOL_attrsNAMELIST	/* Possible. */
-		       | FFESYMBOL_attrsSAVE	/* Possible. */
-		       | FFESYMBOL_attrsSFARG	/* Possible. */
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = ffestu_equiv_ (s);
-    }
-  else if (sa & FFESYMBOL_attrsNAMELIST)
-    {
-      assert (!(sa & (FFESYMBOL_attrsADJUSTS
-		      | FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsEQUIV
-		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		       | FFESYMBOL_attrsARRAY	/* Possible. */
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsINIT	/* Possible. */
-		       | FFESYMBOL_attrsNAMELIST	/* Have it. */
-		       | FFESYMBOL_attrsSAVE
-		       | FFESYMBOL_attrsSFARG	/* Possible. */
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsINIT)
-    {
-      assert (!(sa & (FFESYMBOL_attrsADJUSTS
-		      | FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsEQUIV
-		      | FFESYMBOL_attrsNAMELIST
-		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		       | FFESYMBOL_attrsARRAY	/* Possible. */
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsINIT	/* Have it. */
-		       | FFESYMBOL_attrsNAMELIST
-		       | FFESYMBOL_attrsSAVE
-		       | FFESYMBOL_attrsSFARG	/* Possible. */
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nkd = FFEINFO_kindENTITY;
-      nwh = FFEINFO_whereLOCAL;
-    }
-  else if (sa & FFESYMBOL_attrsSFARG)
-    {
-      assert (!(sa & (FFESYMBOL_attrsADJUSTS
-		      | FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEQUIV
-		      | FFESYMBOL_attrsINIT
-		      | FFESYMBOL_attrsNAMELIST
-		      | FFESYMBOL_attrsRESULT
-		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTS
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsINIT
-		       | FFESYMBOL_attrsNAMELIST
-		       | FFESYMBOL_attrsRESULT
-		       | FFESYMBOL_attrsSAVE
-		       | FFESYMBOL_attrsSFARG	/* Have it. */
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nkd = FFEINFO_kindENTITY;
-
-      if (ffesta_is_entry_valid)
-	{
-	  nwh = FFEINFO_whereNONE;	/* DUMMY, LOCAL. */
-	  ns = FFESYMBOL_stateUNCERTAIN;
-	}
-      else
-	nwh = FFEINFO_whereLOCAL;
-    }
-  else if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
-    {
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsANYSIZE
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsTYPE)));
-
-      nkd = FFEINFO_kindENTITY;
-
-      if (ffestu_symter_exec_transition_ (ffesymbol_dims (s)))
-	na = FFESYMBOL_attrsetNONE;
-
-      if (sa & (FFESYMBOL_attrsANYLEN | FFESYMBOL_attrsANYSIZE))
-	nwh = FFEINFO_whereDUMMY;
-      else if (sa & (FFESYMBOL_attrsADJUSTABLE | FFESYMBOL_attrsANYSIZE))
-	/* Still okay.  */
-	{
-	  nwh = FFEINFO_whereNONE;	/* DUMMY, LOCAL. */
-	  ns = FFESYMBOL_stateUNCERTAIN;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsARRAY)
-    {
-      assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
-		      | FFESYMBOL_attrsANYSIZE
-		      | FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEQUIV
-		      | FFESYMBOL_attrsINIT
-		      | FFESYMBOL_attrsNAMELIST
-		      | FFESYMBOL_attrsSAVE)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN	/* Possible. */
-		       | FFESYMBOL_attrsANYSIZE
-		       | FFESYMBOL_attrsARRAY	/* Have it. */
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsINIT
-		       | FFESYMBOL_attrsNAMELIST
-		       | FFESYMBOL_attrsSAVE
-		       | FFESYMBOL_attrsTYPE)));	/* Possible. */
-
-      nkd = FFEINFO_kindENTITY;
-
-      if (sa & FFESYMBOL_attrsANYLEN)
-	{
-	  assert (ffesta_is_entry_valid);	/* Already diagnosed. */
-	  nwh = FFEINFO_whereDUMMY;
-	}
-      else
-	{
-	  if (ffesta_is_entry_valid)
-	    {
-	      nwh = FFEINFO_whereNONE;	/* DUMMY, LOCAL. */
-	      ns = FFESYMBOL_stateUNCERTAIN;
-	    }
-	  else
-	    nwh = FFEINFO_whereLOCAL;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsANYLEN)
-    {
-      assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
-		      | FFESYMBOL_attrsANYSIZE
-		      | FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsRESULT)));	/* Handled above. */
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsANYLEN	/* Have it. */
-		       | FFESYMBOL_attrsANYSIZE
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsRESULT
-		       | FFESYMBOL_attrsTYPE)));	/* Have it too. */
-
-      if (ffesta_is_entry_valid)
-	{
-	  nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION. */
-	  nwh = FFEINFO_whereNONE;	/* DUMMY, INTRINSIC, RESULT. */
-	  ns = FFESYMBOL_stateUNCERTAIN;
-	  resolve_intrin = FALSE;
-	}
-      else if (ffeintrin_is_intrinsic (ffesymbol_text (s), NULL, FALSE,
-				       &gen, &spec, &imp))
-	{
-	  ffesymbol_signal_change (s);
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_set_generic (s, gen);
-	  ffesymbol_set_specific (s, spec);
-	  ffesymbol_set_implementation (s, imp);
-	  ffesymbol_set_info (s,
-			      ffeinfo_new (FFEINFO_basictypeNONE,
-					   FFEINFO_kindtypeNONE,
-					   0,
-					   FFEINFO_kindNONE,
-					   FFEINFO_whereINTRINSIC,
-					   FFETARGET_charactersizeNONE));
-	  ffesymbol_resolve_intrin (s);
-	  ffesymbol_reference (s, NULL, FALSE);
-	  ffestorag_exec_layout (s);
-	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-	  return s;
-	}
-      else
-	{			/* SPECIAL: can't have CHAR*(*) var in
-				   PROGRAM/BLOCKDATA, unless it isn't
-				   referenced anywhere in the code. */
-	  ffesymbol_signal_change (s);	/* Can't touch this. */
-	  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-	  ffesymbol_resolve_intrin (s);
-	  ffesymbol_reference (s, NULL, FALSE);
-	  ffestorag_exec_layout (s);
-	  ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-	  return s;
-	}
-    }
-  else if (sa & FFESYMBOL_attrsTYPE)
-    {
-      assert (!(sa & (FFESYMBOL_attrsADJUSTABLE
-		      | FFESYMBOL_attrsADJUSTS
-		      | FFESYMBOL_attrsANYLEN
-		      | FFESYMBOL_attrsANYSIZE
-		      | FFESYMBOL_attrsARRAY
-		      | FFESYMBOL_attrsCOMMON
-		      | FFESYMBOL_attrsDUMMY
-		      | FFESYMBOL_attrsEQUIV
-		      | FFESYMBOL_attrsEXTERNAL
-		      | FFESYMBOL_attrsINIT
-		      | FFESYMBOL_attrsNAMELIST
-		      | FFESYMBOL_attrsRESULT
-		      | FFESYMBOL_attrsSAVE
-		      | FFESYMBOL_attrsSFARG
-		      | FFESYMBOL_attrsSFUNC)));
-      assert (!(sa & ~(FFESYMBOL_attrsADJUSTABLE
-		       | FFESYMBOL_attrsADJUSTS
-		       | FFESYMBOL_attrsANYLEN
-		       | FFESYMBOL_attrsANYSIZE
-		       | FFESYMBOL_attrsARRAY
-		       | FFESYMBOL_attrsCOMMON
-		       | FFESYMBOL_attrsDUMMY
-		       | FFESYMBOL_attrsEQUIV
-		       | FFESYMBOL_attrsEXTERNAL
-		       | FFESYMBOL_attrsINIT
-		       | FFESYMBOL_attrsINTRINSIC	/* UNDERSTOOD. */
-		       | FFESYMBOL_attrsNAMELIST
-		       | FFESYMBOL_attrsRESULT
-		       | FFESYMBOL_attrsSAVE
-		       | FFESYMBOL_attrsSFARG
-		       | FFESYMBOL_attrsSFUNC
-		       | FFESYMBOL_attrsTYPE)));	/* Have it. */
-
-      nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION. */
-      nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL, INTRINSIC, LOCAL, RESULT. */
-      ns = FFESYMBOL_stateUNCERTAIN;
-      resolve_intrin = FALSE;
-    }
-  else if (sa & (FFESYMBOL_attrsCBLOCK | FFESYMBOL_attrsSAVECBLOCK))
-    {				/* COMMON block. */
-      assert (!(sa & ~(FFESYMBOL_attrsCBLOCK
-		       | FFESYMBOL_attrsSAVECBLOCK)));
-
-      if (sa & FFESYMBOL_attrsCBLOCK)
-	ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
-      else
-	ffesymbol_set_commonlist (s, NULL);
-      ffestu_list_exec_transition_ (ffesymbol_commonlist (s));
-      nkd = FFEINFO_kindCOMMON;
-      nwh = FFEINFO_whereLOCAL;
-      needs_type = FALSE;
-    }
-  else
-    {				/* First seen in stmt func definition. */
-      assert (sa == FFESYMBOL_attrsetNONE);
-      assert ("Why are we here again?" == NULL);	/* ~~~~~ */
-
-      nkd = FFEINFO_kindNONE;	/* ENTITY, FUNCTION. */
-      nwh = FFEINFO_whereNONE;	/* DUMMY, GLOBAL, LOCAL. */
-      ns = FFESYMBOL_stateUNCERTAIN;	/* Will get repromoted by caller. */
-      needs_type = FALSE;
-    }
-
-  if (na == FFESYMBOL_attrsetNONE)
-    ffesymbol_error (s, ffesta_tokens[0]);
-  else if (!(na & FFESYMBOL_attrsANY)
-	   && (needs_type || (nkd != skd) || (nwh != swh)
-	       || (na != sa) || (ns != ss)))
-    {
-      ffesymbol_signal_change (s);
-      ffesymbol_set_attrs (s, na);	/* Establish new info. */
-      ffesymbol_set_state (s, ns);
-      if ((ffesymbol_common (s) == NULL)
-	  && (ffesymbol_equiv (s) != NULL))
-	ffesymbol_set_common (s, ffeequiv_common (ffesymbol_equiv (s)));
-      ffesymbol_set_info (s,
-			  ffeinfo_new (ffesymbol_basictype (s),
-				       ffesymbol_kindtype (s),
-				       ffesymbol_rank (s),
-				       nkd,
-				       nwh,
-				       ffesymbol_size (s)));
-      if (needs_type && !ffeimplic_establish_symbol (s))
-	ffesymbol_error (s, ffesta_tokens[0]);
-      else if (resolve_intrin)
-	ffesymbol_resolve_intrin (s);
-      ffesymbol_reference (s, NULL, FALSE);
-      ffestorag_exec_layout (s);
-      ffesymbol_signal_unreported (s);	/* For debugging purposes. */
-    }
-
-  return s;
-}
-
-/* ffestu_list_exec_transition_ -- Update SYMTERs in ITEM list w/in symbol
-
-   ffebld list;
-   ffestu_list_exec_transition_(list);
-
-   list contains an FFEBLD_opITEM list of SYMTERs (possibly STARs and
-   other things, too, but we'll ignore the known ones).	 For each SYMTER,
-   we run sym_exec_transition_ on the corresponding ffesymbol (a recursive
-   call, since that's the function that's calling us) to update it's
-   information.	 Then we copy that information into the SYMTER.
-
-   Make sure we don't get called recursively ourselves!	 */
-
-static void
-ffestu_list_exec_transition_ (ffebld list)
-{
-  static bool in_progress = FALSE;
-  ffebld item;
-  ffesymbol symbol;
-
-  assert (!in_progress);
-  in_progress = TRUE;
-
-  for (; list != NULL; list = ffebld_trail (list))
-    {
-      if ((item = ffebld_head (list)) == NULL)
-	continue;		/* Try next item. */
-
-      switch (ffebld_op (item))
-	{
-	case FFEBLD_opSTAR:
-	  break;
-
-	case FFEBLD_opSYMTER:
-	  symbol = ffebld_symter (item);
-	  if (symbol == NULL)
-	    break;		/* Detached from stmt func dummy list. */
-	  symbol = ffecom_sym_exec_transition (symbol);
-	  assert (ffesymbol_kind (symbol) != FFEINFO_kindNONE);
-	  assert (ffesymbol_where (symbol) != FFEINFO_whereNONE);
-	  ffebld_set_info (item, ffesymbol_info (symbol));
-	  break;
-
-	default:
-	  assert ("Unexpected item on list" == NULL);
-	  break;
-	}
-    }
-
-  in_progress = FALSE;
-}
-
-/* ffestu_symter_end_transition_ -- Update SYMTERs in expr w/in symbol
-
-   ffebld expr;
-   ffestu_symter_end_transition_(expr);
-
-   Any SYMTER in expr's tree with whereNONE gets updated to the
-   (recursively transitioned) sym it identifies (DUMMY or COMMON).  */
-
-static bool
-ffestu_symter_end_transition_ (ffebld expr)
-{
-  ffesymbol symbol;
-  bool any = FALSE;
-
-  /* Label used for tail recursion (reset expr and go here instead of calling
-     self). */
-
-tail:				/* :::::::::::::::::::: */
-
-  if (expr == NULL)
-    return any;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opITEM:
-      while (ffebld_trail (expr) != NULL)
-	{
-	  if (ffestu_symter_end_transition_ (ffebld_head (expr)))
-	    any = TRUE;
-	  expr = ffebld_trail (expr);
-	}
-      expr = ffebld_head (expr);
-      goto tail;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opSYMTER:
-      symbol = ffecom_sym_end_transition (ffebld_symter (expr));
-      if ((symbol != NULL)
-	  && ffesymbol_attr (symbol, FFESYMBOL_attrANY))
-	any = TRUE;
-      ffebld_set_info (expr, ffesymbol_info (symbol));
-      break;
-
-    case FFEBLD_opANY:
-      return TRUE;
-
-    default:
-      break;
-    }
-
-  switch (ffebld_arity (expr))
-    {
-    case 2:
-      if (ffestu_symter_end_transition_ (ffebld_left (expr)))
-	any = TRUE;
-      expr = ffebld_right (expr);
-      goto tail;		/* :::::::::::::::::::: */
-
-    case 1:
-      expr = ffebld_left (expr);
-      goto tail;		/* :::::::::::::::::::: */
-
-    default:
-      break;
-    }
-
-  return any;
-}
-
-/* ffestu_symter_exec_transition_ -- Update SYMTERs in expr w/in symbol
-
-   ffebld expr;
-   ffestu_symter_exec_transition_(expr);
-
-   Any SYMTER in expr's tree with whereNONE gets updated to the
-   (recursively transitioned) sym it identifies (DUMMY or COMMON).  */
-
-static bool
-ffestu_symter_exec_transition_ (ffebld expr)
-{
-  ffesymbol symbol;
-  bool any = FALSE;
-
-  /* Label used for tail recursion (reset expr and go here instead of calling
-     self). */
-
-tail:				/* :::::::::::::::::::: */
-
-  if (expr == NULL)
-    return any;
-
-  switch (ffebld_op (expr))
-    {
-    case FFEBLD_opITEM:
-      while (ffebld_trail (expr) != NULL)
-	{
-	  if (ffestu_symter_exec_transition_ (ffebld_head (expr)))
-	    any = TRUE;
-	  expr = ffebld_trail (expr);
-	}
-      expr = ffebld_head (expr);
-      goto tail;		/* :::::::::::::::::::: */
-
-    case FFEBLD_opSYMTER:
-      symbol = ffecom_sym_exec_transition (ffebld_symter (expr));
-      if ((symbol != NULL)
-	  && ffesymbol_attr (symbol, FFESYMBOL_attrANY))
-	any = TRUE;
-      ffebld_set_info (expr, ffesymbol_info (symbol));
-      break;
-
-    case FFEBLD_opANY:
-      return TRUE;
-
-    default:
-      break;
-    }
-
-  switch (ffebld_arity (expr))
-    {
-    case 2:
-      if (ffestu_symter_exec_transition_ (ffebld_left (expr)))
-	any = TRUE;
-      expr = ffebld_right (expr);
-      goto tail;		/* :::::::::::::::::::: */
-
-    case 1:
-      expr = ffebld_left (expr);
-      goto tail;		/* :::::::::::::::::::: */
-
-    default:
-      break;
-    }
-
-  return any;
-}
-
-/* ffestu_dummies_transition_ -- Update SYMTERs in ITEM list w/in entry
-
-   ffebld list;
-   ffesymbol symfunc(ffesymbol s);
-   if (ffestu_dummies_transition_(symfunc,list))
-       // One or more items are still UNCERTAIN.
-
-   list contains an FFEBLD_opITEM list of SYMTERs (possibly STARs and
-   other things, too, but we'll ignore the known ones).	 For each SYMTER,
-   we run symfunc on the corresponding ffesymbol (a recursive
-   call, since that's the function that's calling us) to update it's
-   information.	 Then we copy that information into the SYMTER.
-
-   Return TRUE if any of the SYMTER's has incomplete information.
-
-   Make sure we don't get called recursively ourselves!	 */
-
-static bool
-ffestu_dummies_transition_ (ffesymbol (*symfunc) (ffesymbol), ffebld list)
-{
-  static bool in_progress = FALSE;
-  ffebld item;
-  ffesymbol symbol;
-  bool uncertain = FALSE;
-
-  assert (!in_progress);
-  in_progress = TRUE;
-
-  for (; list != NULL; list = ffebld_trail (list))
-    {
-      if ((item = ffebld_head (list)) == NULL)
-	continue;		/* Try next item. */
-
-      switch (ffebld_op (item))
-	{
-	case FFEBLD_opSTAR:
-	  break;
-
-	case FFEBLD_opSYMTER:
-	  symbol = ffebld_symter (item);
-	  if (symbol == NULL)
-	    break;		/* Detached from stmt func dummy list. */
-	  symbol = (*symfunc) (symbol);
-	  if (ffesymbol_state (symbol) == FFESYMBOL_stateUNCERTAIN)
-	    uncertain = TRUE;
-	  else
-	    {
-	      assert (ffesymbol_kind (symbol) != FFEINFO_kindNONE);
-	      assert (ffesymbol_where (symbol) != FFEINFO_whereNONE);
-	    }
-	  ffebld_set_info (item, ffesymbol_info (symbol));
-	  break;
-
-	default:
-	  assert ("Unexpected item on list" == NULL);
-	  break;
-	}
-    }
-
-  in_progress = FALSE;
-
-  return uncertain;
-}
diff --git a/gcc/f/stu.h b/gcc/f/stu.h
deleted file mode 100644
index e01b741..0000000
--- a/gcc/f/stu.h
+++ /dev/null
@@ -1,69 +0,0 @@
-/* stu.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stu.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STU_H
-#define GCC_F_STU_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "symbol.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-
-/* Declare functions with prototypes. */
-
-ffesymbol ffestu_sym_end_transition (ffesymbol s);
-ffesymbol ffestu_sym_exec_transition (ffesymbol s);
-
-/* Define macros. */
-
-#define ffestu_init_0()
-#define ffestu_init_1()
-#define ffestu_init_2()
-#define ffestu_init_3()
-#define ffestu_init_4()
-#define ffestu_terminate_0()
-#define ffestu_terminate_1()
-#define ffestu_terminate_2()
-#define ffestu_terminate_3()
-#define ffestu_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STU_H */
diff --git a/gcc/f/stv.c b/gcc/f/stv.c
deleted file mode 100644
index cd31ac4..0000000
--- a/gcc/f/stv.c
+++ /dev/null
@@ -1,66 +0,0 @@
-/* stv.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None (despite the name, it doesn't really depend on ffest*)
-
-   Description:
-      Various and sundry info.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stv.h"
-#include "lab.h"
-#include "where.h"
-
-/* Externals defined here. */
-
-ffestvSavestate ffestv_save_state_;
-ffewhereLine ffestv_save_line_;
-ffewhereColumn ffestv_save_col_;
-ffestvAccessstate ffestv_access_state_;
-ffewhereLine ffestv_access_line_;
-ffewhereColumn ffestv_access_col_;
-ffelabNumber ffestv_num_label_defines_;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
diff --git a/gcc/f/stv.h b/gcc/f/stv.h
deleted file mode 100644
index a3f959f..0000000
--- a/gcc/f/stv.h
+++ /dev/null
@@ -1,165 +0,0 @@
-/* stv.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stv.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STV_H
-#define GCC_F_STV_H
-
-/* Simple definitions and enumerations. */
-
-typedef enum
-  {
-    FFESTV_accessstateNONE,	/* Haven't seen PUBLIC or PRIVATE yet. */
-    FFESTV_accessstatePUBLIC,	/* Seen PUBLIC stmt w/o args. */
-    FFESTV_accessstatePRIVATE,	/* Seen PRIVATE stmt w/o args. */
-    FFESTV_accessstateANY,	/* Conflict seen and reported, so stop
-				   whining. */
-    FFESTV_accessstate
-  } ffestvAccessstate;
-
-typedef enum
-  {				/* Format specifier in an I/O statement. */
-    FFESTV_formatNONE,		/* None. */
-    FFESTV_formatLABEL,		/* Label (normal format). */
-    FFESTV_formatCHAREXPR,	/* Character expression (normal format). */
-    FFESTV_formatASTERISK,	/* Asterisk (list-directed). */
-    FFESTV_formatINTEXPR,	/* Integer expression (assigned label). */
-    FFESTV_formatNAMELIST,	/* Namelist (namelist-directed). */
-    FFESTV_format
-  } ffestvFormat;
-
-typedef enum
-  {
-    FFESTV_savestateNONE,	/* Haven't seen SAVE stmt or attribute yet. */
-    FFESTV_savestateSPECIFIC,	/* Seen SAVE stmt w/args or SAVE attr. */
-    FFESTV_savestateALL,	/* Seen SAVE stmt w/o args. */
-    FFESTV_savestateANY,	/* Conflict seen and reported, so stop
-				   whining. */
-    FFESTV_savestate
-  } ffestvSavestate;
-
-typedef enum
-  {
-    FFESTV_stateNIL,		/* Initial state, and after end of outer prog
-				   unit. */
-    FFESTV_statePROGRAM0,	/* After PROGRAM. */
-    FFESTV_statePROGRAM1,	/* Before first non-USE statement. */
-    FFESTV_statePROGRAM2,	/* After IMPLICIT NONE. */
-    FFESTV_statePROGRAM3,	/* After IMPLICIT, PARAMETER, FORMAT. */
-    FFESTV_statePROGRAM4,	/* Before executable stmt or CONTAINS. */
-    FFESTV_statePROGRAM5,	/* After CONTAINS. */
-    FFESTV_stateSUBROUTINE0,	/* After SUBROUTINE. */
-    FFESTV_stateSUBROUTINE1,	/* Before first non-USE statement. */
-    FFESTV_stateSUBROUTINE2,	/* After IMPLICIT NONE. */
-    FFESTV_stateSUBROUTINE3,	/* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
-    FFESTV_stateSUBROUTINE4,	/* Before executable stmt or CONTAINS. */
-    FFESTV_stateSUBROUTINE5,	/* After CONTAINS. */
-    FFESTV_stateFUNCTION0,	/* After FUNCTION. */
-    FFESTV_stateFUNCTION1,	/* Before first non-USE statement. */
-    FFESTV_stateFUNCTION2,	/* After IMPLICIT NONE. */
-    FFESTV_stateFUNCTION3,	/* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
-    FFESTV_stateFUNCTION4,	/* Before executable stmt or CONTAINS. */
-    FFESTV_stateFUNCTION5,	/* After CONTAINS. */
-    FFESTV_stateMODULE0,	/* After MODULE. */
-    FFESTV_stateMODULE1,	/* Before first non-USE statement. */
-    FFESTV_stateMODULE2,	/* After IMPLICIT NONE. */
-    FFESTV_stateMODULE3,	/* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
-    FFESTV_stateMODULE4,	/* Before executable stmt or CONTAINS. */
-    FFESTV_stateMODULE5,	/* After CONTAINS. */
-    FFESTV_stateBLOCKDATA0,	/* After BLOCKDATA. */
-    FFESTV_stateBLOCKDATA1,	/* Before first non-USE statement. */
-    FFESTV_stateBLOCKDATA2,	/* After IMPLICIT NONE. */
-    FFESTV_stateBLOCKDATA3,	/* After IMPLICIT, PARAMETER, FORMAT, ENTRY. */
-    FFESTV_stateBLOCKDATA4,	/* Before executable stmt or CONTAINS. */
-    FFESTV_stateBLOCKDATA5,	/* After CONTAINS. */
-    FFESTV_stateUSE,		/* Before first USE thru last USE. */
-    FFESTV_stateTYPE,		/* After TYPE thru END TYPE. */
-    FFESTV_stateINTERFACE0,	/* After INTERFACE thru MODULE PROCEDURE. */
-    FFESTV_stateINTERFACE1,	/* After MODULE PROCEDURE thru END INTERFACE. */
-    FFESTV_stateSTRUCTURE,	/* After STRUCTURE thru END STRUCTURE. */
-    FFESTV_stateUNION,		/* After UNION thru END UNION. */
-    FFESTV_stateMAP,		/* After MAP thru END MAP. */
-    FFESTV_stateWHERETHEN,	/* After WHERE-construct thru END WHERE. */
-    FFESTV_stateWHERE,		/* After WHERE-stmt thru next stmt. */
-    FFESTV_stateIFTHEN,		/* After IF THEN thru END IF. */
-    FFESTV_stateIF,		/* After IF thru next stmt. */
-    FFESTV_stateDO,		/* After DO thru END DO or terminating label. */
-    FFESTV_stateSELECT0,	/* After SELECT to before first CASE. */
-    FFESTV_stateSELECT1,	/* First CASE in SELECT thru END SELECT. */
-    FFESTV_state
-  } ffestvState;
-
-typedef enum
-  {				/* Unit specifier. */
-    FFESTV_unitNONE,		/* None. */
-    FFESTV_unitINTEXPR,		/* Integer expression (external file unit). */
-    FFESTV_unitASTERISK,	/* Default unit. */
-    FFESTV_unitCHAREXPR,	/* Character expression (internal file unit). */
-    FFESTV_unit
-  } ffestvUnit;
-
-/* Typedefs. */
-
-
-/* Include files needed by this one. */
-
-#include "lab.h"
-#include "where.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-extern ffestvSavestate ffestv_save_state_;
-extern ffewhereLine ffestv_save_line_;
-extern ffewhereColumn ffestv_save_col_;
-extern ffestvAccessstate ffestv_access_state_;
-extern ffewhereLine ffestv_access_line_;
-extern ffewhereColumn ffestv_access_col_;
-extern ffelabNumber ffestv_num_label_defines_;
-
-/* Declare functions with prototypes. */
-
-
-/* Define macros. */
-
-#define ffestv_init_0()
-#define ffestv_init_1()
-#define ffestv_init_2()
-#define ffestv_init_3()
-#define ffestv_init_4()
-#define ffestv_terminate_0()
-#define ffestv_terminate_1()
-#define ffestv_terminate_2()
-#define ffestv_terminate_3()
-#define ffestv_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STV_H */
diff --git a/gcc/f/stw.c b/gcc/f/stw.c
deleted file mode 100644
index 57658de..0000000
--- a/gcc/f/stw.c
+++ /dev/null
@@ -1,428 +0,0 @@
-/* stw.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None (despite the name, it doesn't really depend on ffest*)
-
-   Description:
-      Provides abstraction and stack mechanism to track the block structure
-      of a Fortran program.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "stw.h"
-#include "bld.h"
-#include "com.h"
-#include "info.h"
-#include "lab.h"
-#include "lex.h"
-#include "malloc.h"
-#include "sta.h"
-#include "stv.h"
-#include "symbol.h"
-#include "where.h"
-
-/* Externals defined here. */
-
-ffestw ffestw_stack_top_ = NULL;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-
-/* Internal macros. */
-
-
-/* ffestw_display_state -- DEBUGGING; display current block state
-
-   ffestw_display_state();  */
-
-void
-ffestw_display_state (void)
-{
-  assert (ffestw_stack_top_ != NULL);
-
-  if (!ffe_is_ffedebug ())
-    return;
-
-  fprintf (dmpout, "; block %lu, state ", ffestw_stack_top_->blocknum_);
-  switch (ffestw_stack_top_->state_)
-    {
-    case FFESTV_stateNIL:
-      fputs ("NIL", dmpout);
-      break;
-
-    case FFESTV_statePROGRAM0:
-      fputs ("PROGRAM0", dmpout);
-      break;
-
-    case FFESTV_statePROGRAM1:
-      fputs ("PROGRAM1", dmpout);
-      break;
-
-    case FFESTV_statePROGRAM2:
-      fputs ("PROGRAM2", dmpout);
-      break;
-
-    case FFESTV_statePROGRAM3:
-      fputs ("PROGRAM3", dmpout);
-      break;
-
-    case FFESTV_statePROGRAM4:
-      fputs ("PROGRAM4", dmpout);
-      break;
-
-    case FFESTV_statePROGRAM5:
-      fputs ("PROGRAM5", dmpout);
-      break;
-
-    case FFESTV_stateSUBROUTINE0:
-      fputs ("SUBROUTINE0", dmpout);
-      break;
-
-    case FFESTV_stateSUBROUTINE1:
-      fputs ("SUBROUTINE1", dmpout);
-      break;
-
-    case FFESTV_stateSUBROUTINE2:
-      fputs ("SUBROUTINE2", dmpout);
-      break;
-
-    case FFESTV_stateSUBROUTINE3:
-      fputs ("SUBROUTINE3", dmpout);
-      break;
-
-    case FFESTV_stateSUBROUTINE4:
-      fputs ("SUBROUTINE4", dmpout);
-      break;
-
-    case FFESTV_stateSUBROUTINE5:
-      fputs ("SUBROUTINE5", dmpout);
-      break;
-
-    case FFESTV_stateFUNCTION0:
-      fputs ("FUNCTION0", dmpout);
-      break;
-
-    case FFESTV_stateFUNCTION1:
-      fputs ("FUNCTION1", dmpout);
-      break;
-
-    case FFESTV_stateFUNCTION2:
-      fputs ("FUNCTION2", dmpout);
-      break;
-
-    case FFESTV_stateFUNCTION3:
-      fputs ("FUNCTION3", dmpout);
-      break;
-
-    case FFESTV_stateFUNCTION4:
-      fputs ("FUNCTION4", dmpout);
-      break;
-
-    case FFESTV_stateFUNCTION5:
-      fputs ("FUNCTION5", dmpout);
-      break;
-
-    case FFESTV_stateMODULE0:
-      fputs ("MODULE0", dmpout);
-      break;
-
-    case FFESTV_stateMODULE1:
-      fputs ("MODULE1", dmpout);
-      break;
-
-    case FFESTV_stateMODULE2:
-      fputs ("MODULE2", dmpout);
-      break;
-
-    case FFESTV_stateMODULE3:
-      fputs ("MODULE3", dmpout);
-      break;
-
-    case FFESTV_stateMODULE4:
-      fputs ("MODULE4", dmpout);
-      break;
-
-    case FFESTV_stateMODULE5:
-      fputs ("MODULE5", dmpout);
-      break;
-
-    case FFESTV_stateBLOCKDATA0:
-      fputs ("BLOCKDATA0", dmpout);
-      break;
-
-    case FFESTV_stateBLOCKDATA1:
-      fputs ("BLOCKDATA1", dmpout);
-      break;
-
-    case FFESTV_stateBLOCKDATA2:
-      fputs ("BLOCKDATA2", dmpout);
-      break;
-
-    case FFESTV_stateBLOCKDATA3:
-      fputs ("BLOCKDATA3", dmpout);
-      break;
-
-    case FFESTV_stateBLOCKDATA4:
-      fputs ("BLOCKDATA4", dmpout);
-      break;
-
-    case FFESTV_stateBLOCKDATA5:
-      fputs ("BLOCKDATA5", dmpout);
-      break;
-
-    case FFESTV_stateUSE:
-      fputs ("USE", dmpout);
-      break;
-
-    case FFESTV_stateTYPE:
-      fputs ("TYPE", dmpout);
-      break;
-
-    case FFESTV_stateINTERFACE0:
-      fputs ("INTERFACE0", dmpout);
-      break;
-
-    case FFESTV_stateINTERFACE1:
-      fputs ("INTERFACE1", dmpout);
-      break;
-
-    case FFESTV_stateSTRUCTURE:
-      fputs ("STRUCTURE", dmpout);
-      break;
-
-    case FFESTV_stateUNION:
-      fputs ("UNION", dmpout);
-      break;
-
-    case FFESTV_stateMAP:
-      fputs ("MAP", dmpout);
-      break;
-
-    case FFESTV_stateWHERETHEN:
-      fputs ("WHERETHEN", dmpout);
-      break;
-
-    case FFESTV_stateWHERE:
-      fputs ("WHERE", dmpout);
-      break;
-
-    case FFESTV_stateIFTHEN:
-      fputs ("IFTHEN", dmpout);
-      break;
-
-    case FFESTV_stateIF:
-      fputs ("IF", dmpout);
-      break;
-
-    case FFESTV_stateDO:
-      fputs ("DO", dmpout);
-      break;
-
-    case FFESTV_stateSELECT0:
-      fputs ("SELECT0", dmpout);
-      break;
-
-    case FFESTV_stateSELECT1:
-      fputs ("SELECT1", dmpout);
-      break;
-
-    default:
-      assert ("bad state" == NULL);
-      break;
-    }
-  if (ffestw_stack_top_->top_do_ != NULL)
-    fputs (" (within DO)", dmpout);
-  fputc ('\n', dmpout);
-}
-
-/* ffestw_init_0 -- Initialize ffestw structures
-
-   ffestw_init_0();  */
-
-void
-ffestw_init_0 (void)
-{
-  ffestw 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;
-  b->previous_ = NULL;
-  b->top_do_ = NULL;
-  b->blocknum_ = 0;
-  b->shriek_ = NULL;
-  b->state_ = FFESTV_stateNIL;
-  b->line_ = ffewhere_line_unknown ();
-  b->col_ = ffewhere_column_unknown ();
-}
-
-/* ffestw_kill -- Kill block
-
-   ffestw b;
-   ffestw_kill(b);  */
-
-void
-ffestw_kill (ffestw b)
-{
-  assert (b != NULL);
-  assert (b->uses_ > 0);
-
-  if (--b->uses_ != 0)
-    return;
-
-  ffewhere_line_kill (b->line_);
-  ffewhere_column_kill (b->col_);
-}
-
-/* ffestw_new -- Create block
-
-   ffestw b;
-   b = ffestw_new();  */
-
-ffestw
-ffestw_new (void)
-{
-  ffestw b;
-
-  b = malloc_new_kp (malloc_pool_image (), "FFESTW", sizeof (*b));
-  b->uses_ = 1;
-
-  return b;
-}
-
-/* ffestw_pop -- Pop block off stack
-
-   ffestw_pop();  */
-
-ffestw
-ffestw_pop (void)
-{
-  ffestw b;
-  ffestw oldb = ffestw_stack_top_;
-
-  assert (oldb != NULL);
-  ffestw_stack_top_ = b = ffestw_stack_top_->previous_;
-  assert (b != NULL);
-  if ((ffewhere_line_is_unknown (b->line_) || ffewhere_column_is_unknown (b->col_))
-      && (ffesta_tokens[0] != NULL))
-    {
-      assert (b->state_ == FFESTV_stateNIL);
-      if (ffewhere_line_is_unknown (b->line_))
-	b->line_
-	  = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
-      if (ffewhere_column_is_unknown (b->col_))
-	b->col_
-	  = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
-    }
-
-  return oldb;
-}
-
-/* ffestw_push -- Push block onto stack, return its address
-
-   ffestw b;  // NULL if new block to be obtained first.
-   ffestw_push(b);
-
-   Returns address of block if desired, also updates ffestw_stack_top_
-   to point to it.
-
-   30-Oct-91  JCB  2.0
-      Takes block as arg, or NULL if new block needed.	*/
-
-ffestw
-ffestw_push (ffestw b)
-{
-  if (b == NULL)
-    b = ffestw_new ();
-
-  b->next_ = NULL;
-  b->previous_ = ffestw_stack_top_;
-  b->line_ = ffewhere_line_unknown ();
-  b->col_ = ffewhere_column_unknown ();
-  ffestw_stack_top_ = b;
-  return b;
-}
-
-/* ffestw_update -- Update current block line/col info
-
-   ffestw_update();
-
-   Updates block to point to current statement.	 */
-
-ffestw
-ffestw_update (ffestw b)
-{
-  if (b == NULL)
-    {
-      b = ffestw_stack_top_;
-      assert (b != NULL);
-    }
-
-  if (ffesta_tokens[0] == NULL)
-    return b;
-
-  ffewhere_line_kill (b->line_);
-  ffewhere_column_kill (b->col_);
-  b->line_ = ffewhere_line_use (ffelex_token_where_line (ffesta_tokens[0]));
-  b->col_ = ffewhere_column_use (ffelex_token_where_column (ffesta_tokens[0]));
-
-  return b;
-}
-
-/* ffestw_use -- Mark extra use of block
-
-   ffestw b;
-   b = ffestw_use(b);  // will always return original copy of b
-
-   Increments use counter for b.  */
-
-ffestw
-ffestw_use (ffestw b)
-{
-  assert (b != NULL);
-  assert (b->uses_ != 0);
-
-  ++b->uses_;
-
-  return b;
-}
diff --git a/gcc/f/stw.h b/gcc/f/stw.h
deleted file mode 100644
index 080bd73..0000000
--- a/gcc/f/stw.h
+++ /dev/null
@@ -1,185 +0,0 @@
-/* stw.h -- Private #include File (module.h template V1.0)
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      stw.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_STW_H
-#define GCC_F_STW_H
-
-/* Simple definitions and enumerations. */
-
-
-/* Typedefs. */
-
-typedef struct _ffestw_ *ffestw;
-typedef struct _ffestw_case_ *ffestwCase;
-typedef struct _ffestw_select_ *ffestwSelect;
-typedef void (*ffestwShriek) (bool ok);
-
-/* Include files needed by this one. */
-
-#include "bld.h"
-#include "com.h"
-#include "info.h"
-#include "lab.h"
-#include "lex.h"
-#include "malloc.h"
-#include "stv.h"
-#include "symbol.h"
-#include "where.h"
-
-/* Structure definitions. */
-
-struct _ffestw_
-  {
-    ffestw next_;		/* Next (unused) block, or NULL. */
-    ffestw previous_;		/* Previous block, NULL if this is NIL state. */
-    ffestw top_do_;		/* Previous or current DO state, or NULL. */
-    unsigned long blocknum_;	/* Block # w/in procedure/program. */
-    ffestwShriek shriek_;	/* Call me to pop block in a hurry. */
-    ffesymbol sym_;		/* Related symbol (if there is one). */
-    ffelexToken name_;		/* Construct name (IFTHEN, SELECT, DO only). */
-    ffestwSelect select_;	/* Info for SELECT CASE blocks. */
-    ffelab label_;		/* For DO blocks w/labels, the target label. */
-    ffesymbol do_iter_var_;	/* For iter DO blocks, the iter var or NULL. */
-    ffelexToken do_iter_var_t_;	/* The token for do_iter_var. */
-    ffewhereLine line_;		/* Where first token of statement triggering
-				   state */
-    ffewhereColumn col_;	/* was seen in source file. */
-    int uses_;			/* # uses (new+use-kill calls). */
-    ffestvState state_;
-    int substate_;		/* Used on a per-block-state basis. */
-    struct nesting *do_hook_;	/* backend id for given loop (EXIT/CYCLE). */
-    tree do_tvar_;		/* tree form of do_iter_var. */
-    tree do_incr_saved_;	/* tree SAVED_EXPR of incr expr. */
-    tree do_count_var_;		/* tree of countdown variable. */
-    tree select_texpr_;		/* tree for end case. */
-    bool select_break_;		/* TRUE when CASE should start with gen
-				   "break;". */
-    int ifthen_fake_else_;	/* Number of fake `else' introductions.  */
-  };
-
-struct _ffestw_case_
-  {
-    ffestwCase next_rel;	/* Next case range in relational order. */
-    ffestwCase previous_rel;	/* Previous case range in relational order. */
-    ffestwCase next_stmt;	/* Next range in stmt or first in next stmt. */
-    ffestwCase previous_stmt;	/* Previous range. */
-    ffebldConstant low;		/* Low value in range. */
-    ffebldConstant high;	/* High value in range. */
-    unsigned long casenum;	/* CASE stmt index for this range/value. */
-    ffelexToken t;		/* Token for this range/value; ffestc only. */
-  };
-
-struct _ffestw_select_
-  {
-    ffestwCase first_rel;	/* First CASE range (after low) in order. */
-    ffestwCase last_rel;	/* Last CASE range (before high) in order. */
-    ffestwCase first_stmt;	/* First range in first CASE stmt. */
-    ffestwCase last_stmt;	/* Last range in last CASE stmt. */
-    mallocPool pool;		/* Pool in which this and all cases are
-				   allocated. */
-    unsigned long cases;	/* Number of CASE stmts seen so far. */
-    ffelexToken t;		/* First token of selected expression; ffestc
-				   only. */
-    ffeinfoBasictype type;	/* Basic type (integer, character, or
-				   logical). */
-    ffeinfoKindtype kindtype;	/* Kind type. */
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern ffestw ffestw_stack_top_;
-
-/* Declare functions with prototypes. */
-
-void ffestw_display_state (void);
-void ffestw_kill (ffestw block);
-void ffestw_init_0 (void);
-ffestw ffestw_new (void);
-ffestw ffestw_pop (void);
-ffestw ffestw_push (ffestw block);
-ffestw ffestw_update (ffestw block);
-ffestw ffestw_use (ffestw block);
-
-/* Define macros. */
-
-#define ffestw_blocknum(b) ((b)->blocknum_)
-#define ffestw_col(b) ((b)->col_)
-#define ffestw_do_count_var(b) ((b)->do_count_var_)
-#define ffestw_do_hook(b) ((b)->do_hook_)
-#define ffestw_do_incr_saved(b) ((b)->do_incr_saved_)
-#define ffestw_do_iter_var(b) ((b)->do_iter_var_)
-#define ffestw_do_iter_var_t(b) ((b)->do_iter_var_t_)
-#define ffestw_do_tvar(b) ((b)->do_tvar_)
-#define ffestw_ifthen_fake_else(b) ((b)->ifthen_fake_else_)
-#define ffestw_init_1()
-#define ffestw_init_2()
-#define ffestw_init_3()
-#define ffestw_init_4()
-#define ffestw_label(b) ((b)->label_)
-#define ffestw_line(b) ((b)->line_)
-#define ffestw_name(b) ((b)->name_)
-#define ffestw_previous(b) ((b)->previous_)
-#define ffestw_select(b) ((b)->select_)
-#define ffestw_select_break(b) ((b)->select_break_)
-#define ffestw_select_texpr(b) ((b)->select_texpr_)
-#define ffestw_set_blocknum(b,bl) ((b)->blocknum_ = (bl))
-#define ffestw_set_col(b,c) ((b)->col_ = (c))
-#define ffestw_set_do_count_var(b,d) ((b)->do_count_var_ = (d))
-#define ffestw_set_do_hook(b,d) ((b)->do_hook_ = (d))
-#define ffestw_set_do_incr_saved(b,d) ((b)->do_incr_saved_ = (d))
-#define ffestw_set_do_iter_var(b,v) ((b)->do_iter_var_ = (v))
-#define ffestw_set_do_iter_var_t(b,t) ((b)->do_iter_var_t_ = (t))
-#define ffestw_set_do_tvar(b,d) ((b)->do_tvar_ = (d))
-#define ffestw_set_ifthen_fake_else(b,e) ((b)->ifthen_fake_else_ = (e))
-#define ffestw_set_label(b,l) ((b)->label_ = (l))
-#define ffestw_set_line(b,l) ((b)->line_ = (l))
-#define ffestw_set_name(b,n) ((b)->name_ = (n))
-#define ffestw_set_select(b,s) ((b)->select_ = (s))
-#define ffestw_set_select_break(b,br) ((b)->select_break_ = (br))
-#define ffestw_set_select_texpr(b,t) ((b)->select_texpr_ = (t))
-#define ffestw_set_shriek(b,s) ((b)->shriek_ = (s))
-#define ffestw_set_state(b,s) ((b)->state_ = (s))
-#define ffestw_set_substate(b,s) ((b)->substate_ = (s))
-#define ffestw_set_sym(b,s) ((b)->sym_= (s))
-#define ffestw_set_top_do(b,t) ((b)->top_do_ = (t))
-#define ffestw_shriek(b) ((b)->shriek_)
-#define ffestw_stack_top() ffestw_stack_top_
-#define ffestw_state(b) ((b)->state_)
-#define ffestw_substate(b) ((b)->substate_)
-#define ffestw_sym(b) ((b)->sym_)
-#define ffestw_terminate_0()
-#define ffestw_terminate_1()
-#define ffestw_terminate_2()
-#define ffestw_terminate_3()
-#define ffestw_terminate_4()
-#define ffestw_top_do(b) ((b)->top_do_)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_STW_H */
diff --git a/gcc/f/symbol.c b/gcc/f/symbol.c
deleted file mode 100644
index c22697f..0000000
--- a/gcc/f/symbol.c
+++ /dev/null
@@ -1,1253 +0,0 @@
-/* Implementation of Fortran symbol manager
-   Copyright (C) 1995, 1996, 1997, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 "proj.h"
-#include "symbol.h"
-#include "bad.h"
-#include "bld.h"
-#include "com.h"
-#include "equiv.h"
-#include "global.h"
-#include "info.h"
-#include "intrin.h"
-#include "lex.h"
-#include "malloc.h"
-#include "src.h"
-#include "st.h"
-#include "storag.h"
-#include "target.h"
-#include "where.h"
-
-/* Choice of how to handle global symbols -- either global only within the
-   program unit being defined or global within the entire source file.
-   The former is appropriate for systems where an object file can
-   easily be taken apart program unit by program unit, the latter is the
-   UNIX/C model where the object file is essentially a monolith.  */
-
-#define FFESYMBOL_globalPROGUNIT_ 1
-#define FFESYMBOL_globalFILE_ 2
-
-/* Choose how to handle global symbols here.  */
-
-/* Would be good to understand why PROGUNIT in this case too.
-   (1995-08-22).  */
-#define FFESYMBOL_globalCURRENT_ FFESYMBOL_globalPROGUNIT_
-
-/* Choose how to handle memory pools based on global symbol stuff.  */
-
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
-#define FFESYMBOL_SPACE_POOL_ ffe_pool_program_unit()
-#elif FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
-#define FFESYMBOL_SPACE_POOL_ ffe_pool_file()
-#else
-#error
-#endif
-
-/* What kind of retraction is needed for a symbol?  */
-
-enum _ffesymbol_retractcommand_
-  {
-    FFESYMBOL_retractcommandDELETE_,
-    FFESYMBOL_retractcommandRETRACT_,
-    FFESYMBOL_retractcommand_
-  };
-typedef enum _ffesymbol_retractcommand_ ffesymbolRetractCommand_;
-
-/* This object keeps track of retraction for a symbol and links to the next
-   such object.  */
-
-typedef struct _ffesymbol_retract_ *ffesymbolRetract_;
-struct _ffesymbol_retract_
-  {
-    ffesymbolRetract_ next;
-    ffesymbolRetractCommand_ command;
-    ffesymbol live;		/* Live symbol. */
-    ffesymbol symbol;		/* Backup copy of symbol. */
-  };
-
-static ffebad ffesymbol_check_token_ (ffelexToken t, char *c);
-static void ffesymbol_kill_manifest_ (void);
-static ffesymbol ffesymbol_new_ (ffename n);
-static ffesymbol ffesymbol_unhook_ (ffesymbol s);
-static void ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c);
-
-/* Manifest names for unnamed things (as tokens) so we make them only
-   once.  */
-
-static ffelexToken ffesymbol_token_blank_common_ = NULL;
-static ffelexToken ffesymbol_token_unnamed_main_ = NULL;
-static ffelexToken ffesymbol_token_unnamed_blockdata_ = NULL;
-
-/* Name spaces currently in force.  */
-
-static ffenameSpace ffesymbol_global_ = NULL;
-static ffenameSpace ffesymbol_local_ = NULL;
-static ffenameSpace ffesymbol_sfunc_ = NULL;
-
-/* Keep track of retraction.  */
-
-static bool ffesymbol_retractable_ = FALSE;
-static mallocPool ffesymbol_retract_pool_;
-static ffesymbolRetract_ ffesymbol_retract_first_;
-static ffesymbolRetract_ *ffesymbol_retract_list_;
-
-/* List of state names. */
-
-static const char *const ffesymbol_state_name_[] =
-{
-  "?",
-  "@",
-  "&",
-  "$",
-};
-
-/* List of attribute names. */
-
-static const char *const ffesymbol_attr_name_[] =
-{
-#define DEFATTR(ATTR,ATTRS,NAME) NAME,
-#include "symbol.def"
-#undef DEFATTR
-};
-
-
-/* Check whether the token text has any invalid characters.  If not,
-   return FALSE.  If so, if error messages inhibited, return TRUE
-   so caller knows to try again later, else report error and return
-   FALSE.  */
-
-static ffebad
-ffesymbol_check_token_ (ffelexToken t, char *c)
-{
-  char *p = ffelex_token_text (t);
-  ffeTokenLength len = ffelex_token_length (t);
-  ffebad bad;
-  ffeTokenLength i = 0;
-  ffebad skip_me = ((ffe_case_symbol () == FFE_caseINITCAP)
-		    ? FFEBAD_SYMBOL_NOLOWER_INITCAP : FFEBAD + 1);
-  ffebad stop_me = ((ffe_case_symbol () == FFE_caseINITCAP)
-		    ? FFEBAD : FFEBAD + 1);
-  if (len == 0)
-    return FFEBAD;
-
-  bad = ffesrc_bad_char_symbol_init (*p);
-  if (bad == FFEBAD)
-    {
-      for (++i, ++p; i < len; ++i, ++p)
-	{
-	  bad = ffesrc_bad_char_symbol_noninit (*p);
-	  if (bad == skip_me)
-	    continue;		/* Keep looking for good InitCap character. */
-	  if (bad == stop_me)
-	    break;		/* Found good InitCap character. */
-	  if (bad != FFEBAD)
-	    break;		/* Bad character found. */
-	}
-    }
-
-  if (bad != FFEBAD)
-    {
-      if (i >= len)
-	*c = *(ffelex_token_text (t));
-      else
-	*c = *p;
-    }
-
-  return bad;
-}
-
-/* Kill manifest (g77-picked) names.  */
-
-static void
-ffesymbol_kill_manifest_ (void)
-{
-  if (ffesymbol_token_blank_common_ != NULL)
-    ffelex_token_kill (ffesymbol_token_blank_common_);
-  if (ffesymbol_token_unnamed_main_ != NULL)
-    ffelex_token_kill (ffesymbol_token_unnamed_main_);
-  if (ffesymbol_token_unnamed_blockdata_ != NULL)
-    ffelex_token_kill (ffesymbol_token_unnamed_blockdata_);
-
-  ffesymbol_token_blank_common_ = NULL;
-  ffesymbol_token_unnamed_main_ = NULL;
-  ffesymbol_token_unnamed_blockdata_ = NULL;
-}
-
-/* Make new symbol.
-
-   If the "retractable" flag is not set, just return the new symbol.
-   Else, add symbol to the "retract" list as a delete item, set
-   the "have_old" flag, and return the new symbol.  */
-
-static ffesymbol
-ffesymbol_new_ (ffename n)
-{
-  ffesymbol s;
-  ffesymbolRetract_ r;
-
-  assert (n != NULL);
-
-  s = malloc_new_ks (FFESYMBOL_SPACE_POOL_, "FFESYMBOL", sizeof (*s));
-  s->name = n;
-  s->other_space_name = NULL;
-#if FFEGLOBAL_ENABLED
-  s->global = NULL;
-#endif
-  s->attrs = FFESYMBOL_attrsetNONE;
-  s->state = FFESYMBOL_stateNONE;
-  s->info = ffeinfo_new_null ();
-  s->dims = NULL;
-  s->extents = NULL;
-  s->dim_syms = NULL;
-  s->array_size = NULL;
-  s->init = NULL;
-  s->accretion = NULL;
-  s->accretes = 0;
-  s->dummy_args = NULL;
-  s->namelist = NULL;
-  s->common_list = NULL;
-  s->sfunc_expr = NULL;
-  s->list_bottom = NULL;
-  s->common = NULL;
-  s->equiv = NULL;
-  s->storage = NULL;
-  s->hook = FFECOM_symbolNULL;
-  s->sfa_dummy_parent = NULL;
-  s->func_result = NULL;
-  s->value = 0;
-  s->check_state = FFESYMBOL_checkstateNONE_;
-  s->check_token = NULL;
-  s->max_entry_num = 0;
-  s->num_entries = 0;
-  s->generic = FFEINTRIN_genNONE;
-  s->specific = FFEINTRIN_specNONE;
-  s->implementation = FFEINTRIN_impNONE;
-  s->is_save = FALSE;
-  s->is_init = FALSE;
-  s->do_iter = FALSE;
-  s->reported = FALSE;
-  s->explicit_where = FALSE;
-  s->namelisted = FALSE;
-  s->assigned = FALSE;
-
-  ffename_set_symbol (n, s);
-
-  if (!ffesymbol_retractable_)
-    {
-      s->have_old = FALSE;
-      return s;
-    }
-
-  r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract",
-		     sizeof (*r));
-  r->next = NULL;
-  r->command = FFESYMBOL_retractcommandDELETE_;
-  r->live = s;
-  r->symbol = NULL;		/* No backup copy. */
-
-  *ffesymbol_retract_list_ = r;
-  ffesymbol_retract_list_ = &r->next;
-
-  s->have_old = TRUE;
-  return s;
-}
-
-/* Unhook a symbol from its (soon-to-be-killed) name obj.
-
-   NULLify the names to which this symbol points.  Do other cleanup as
-   needed.  */
-
-static ffesymbol
-ffesymbol_unhook_ (ffesymbol s)
-{
-  s->other_space_name = s->name = NULL;
-  if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
-      || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
-    ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
-  if (s->check_state == FFESYMBOL_checkstatePENDING_)
-    ffelex_token_kill (s->check_token);
-
-  return s;
-}
-
-/* Issue diagnostic about bad character in token representing user-defined
-   symbol name.	 */
-
-static void
-ffesymbol_whine_state_ (ffebad bad, ffelexToken t, char c)
-{
-  char badstr[2];
-
-  badstr[0] = c;
-  badstr[1] = '\0';
-
-  ffebad_start (bad);
-  ffebad_here (0, ffelex_token_where_line (t),
-	       ffelex_token_where_column (t));
-  ffebad_string (badstr);
-  ffebad_finish ();
-}
-
-/* Returns a string representing the attributes set.  */
-
-const char *
-ffesymbol_attrs_string (ffesymbolAttrs attrs)
-{
-  static char string[FFESYMBOL_attr * 12 + 20];
-  char *p;
-  ffesymbolAttr attr;
-
-  p = &string[0];
-
-  if (attrs == FFESYMBOL_attrsetNONE)
-    {
-      strcpy (p, "NONE");
-      return &string[0];
-    }
-
-  for (attr = 0; attr < FFESYMBOL_attr; ++attr)
-    {
-      if (attrs & ((ffesymbolAttrs) 1 << attr))
-	{
-	  attrs &= ~((ffesymbolAttrs) 1 << attr);
-	  strcpy (p, ffesymbol_attr_name_[attr]);
-	  while (*p)
-	    ++p;
-	  *(p++) = '|';
-	}
-    }
-  if (attrs == FFESYMBOL_attrsetNONE)
-    *--p = '\0';
-  else
-    sprintf (p, "?0x%" ffesymbolAttrs_f "x?", attrs);
-  assert (((size_t) (p - &string[0])) < ARRAY_SIZE (string));
-  return &string[0];
-}
-
-/* Check symbol's name for validity, considering that it might actually
-   be an intrinsic and thus should not be complained about just yet.  */
-
-void
-ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin)
-{
-  char c;
-  ffebad bad;
-  ffeintrinGen gen;
-  ffeintrinSpec spec;
-  ffeintrinImp imp;
-
-  if (!ffesrc_check_symbol ()
-      || ((s->check_state != FFESYMBOL_checkstateNONE_)
-	  && ((s->check_state != FFESYMBOL_checkstateINHIBITED_)
-	      || ffebad_inhibit ())))
-    return;
-
-  bad = ffesymbol_check_token_ (t, &c);
-
-  if (bad == FFEBAD)
-    {
-      s->check_state = FFESYMBOL_checkstateCHECKED_;
-      return;
-    }
-
-  if (maybe_intrin
-      && ffeintrin_is_intrinsic (ffelex_token_text (t), NULL, FALSE,
-				 &gen, &spec, &imp))
-    {
-      s->check_state = FFESYMBOL_checkstatePENDING_;
-      s->check_token = ffelex_token_use (t);
-      return;
-    }
-
-  if (ffebad_inhibit ())
-    {
-      s->check_state = FFESYMBOL_checkstateINHIBITED_;
-      return;			/* Don't complain now, do it later. */
-    }
-
-  s->check_state = FFESYMBOL_checkstateCHECKED_;
-
-  ffesymbol_whine_state_ (bad, t, c);
-}
-
-/* Declare a BLOCKDATA unit.
-
-   Retrieves or creates the ffesymbol for the specified BLOCKDATA (unnamed
-   if t is NULL).  Doesn't actually ensure the named item is a
-   BLOCKDATA; the caller must handle that.  */
-
-ffesymbol
-ffesymbol_declare_blockdataunit (ffelexToken t, ffewhereLine wl,
-				 ffewhereColumn wc)
-{
-  ffename n;
-  ffesymbol s;
-  bool user = (t != NULL);
-
-  assert (!ffesymbol_retractable_);
-
-  if (t == NULL)
-    {
-      if (ffesymbol_token_unnamed_blockdata_ == NULL)
-	ffesymbol_token_unnamed_blockdata_
-	  = ffelex_token_new_name (FFETARGET_nameUNNAMED_BLOCK_DATA, wl, wc);
-      t = ffesymbol_token_unnamed_blockdata_;
-    }
-
-  n = ffename_lookup (ffesymbol_local_, t);
-  if (n != NULL)
-    return ffename_symbol (n);	/* This will become an error. */
-
-  n = ffename_find (ffesymbol_global_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      if (user)
-	ffesymbol_check (s, t, FALSE);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  if (user)
-    ffesymbol_check (s, t, FALSE);
-
-  /* A program unit name also is in the local name space. */
-
-  n = ffename_find (ffesymbol_local_, t);
-  ffename_set_symbol (n, s);
-  s->other_space_name = n;
-
-  ffeglobal_new_blockdata (s, t);	/* Detect conflicts, when
-					   appropriate. */
-
-  return s;
-}
-
-/* Declare a common block (named or unnamed).
-
-   Retrieves or creates the ffesymbol for the specified common block (blank
-   common if t is NULL).  Doesn't actually ensure the named item is a
-   common block; the caller must handle that.  */
-
-ffesymbol
-ffesymbol_declare_cblock (ffelexToken t, ffewhereLine wl, ffewhereColumn wc)
-{
-  ffename n;
-  ffesymbol s;
-  bool blank;
-
-  assert (!ffesymbol_retractable_);
-
-  if (t == NULL)
-    {
-      blank = TRUE;
-      if (ffesymbol_token_blank_common_ == NULL)
-	ffesymbol_token_blank_common_
-	  = ffelex_token_new_name (FFETARGET_nameBLANK_COMMON, wl, wc);
-      t = ffesymbol_token_blank_common_;
-    }
-  else
-    blank = FALSE;
-
-  n = ffename_find (ffesymbol_global_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      if (!blank)
-	ffesymbol_check (s, t, FALSE);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  if (!blank)
-    ffesymbol_check (s, t, FALSE);
-
-  ffeglobal_new_common (s, t, blank);	/* Detect conflicts. */
-
-  return s;
-}
-
-/* Declare a FUNCTION program unit (with distinct RESULT() name).
-
-   Retrieves or creates the ffesymbol for the specified function.  Doesn't
-   actually ensure the named item is a function; the caller must handle
-   that.
-
-   If FUNCTION with RESULT() is specified but the names are the same,
-   pretend as though RESULT() was not specified, and don't call this
-   function; use ffesymbol_declare_funcunit() instead.	*/
-
-ffesymbol
-ffesymbol_declare_funcnotresunit (ffelexToken t)
-{
-  ffename n;
-  ffesymbol s;
-
-  assert (t != NULL);
-  assert (!ffesymbol_retractable_);
-
-  n = ffename_lookup (ffesymbol_local_, t);
-  if (n != NULL)
-    return ffename_symbol (n);	/* This will become an error. */
-
-  n = ffename_find (ffesymbol_global_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      ffesymbol_check (s, t, FALSE);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  ffesymbol_check (s, t, FALSE);
-
-  /* A FUNCTION program unit name also is in the local name space; handle it
-     here since RESULT() is a different name and is handled separately. */
-
-  n = ffename_find (ffesymbol_local_, t);
-  ffename_set_symbol (n, s);
-  s->other_space_name = n;
-
-  ffeglobal_new_function (s, t);/* Detect conflicts, when appropriate. */
-
-  return s;
-}
-
-/* Declare a function result.
-
-   Retrieves or creates the ffesymbol for the specified function result,
-   whether specified via a distinct RESULT() or by default in a FUNCTION or
-   ENTRY statement.  */
-
-ffesymbol
-ffesymbol_declare_funcresult (ffelexToken t)
-{
-  ffename n;
-  ffesymbol s;
-
-  assert (t != NULL);
-  assert (!ffesymbol_retractable_);
-
-  n = ffename_find (ffesymbol_local_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    return s;
-
-  return ffesymbol_new_ (n);
-}
-
-/* Declare a FUNCTION program unit with no RESULT().
-
-   Retrieves or creates the ffesymbol for the specified function.  Doesn't
-   actually ensure the named item is a function; the caller must handle
-   that.
-
-   This is the function to call when the FUNCTION or ENTRY statement has
-   no separate and distinct name specified via RESULT().  That's because
-   this function enters the global name of the function in only the global
-   name space.	ffesymbol_declare_funcresult() must still be called to
-   declare the name for the function result in the local name space.  */
-
-ffesymbol
-ffesymbol_declare_funcunit (ffelexToken t)
-{
-  ffename n;
-  ffesymbol s;
-
-  assert (t != NULL);
-  assert (!ffesymbol_retractable_);
-
-  n = ffename_find (ffesymbol_global_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      ffesymbol_check (s, t, FALSE);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  ffesymbol_check (s, t, FALSE);
-
-  ffeglobal_new_function (s, t);/* Detect conflicts. */
-
-  return s;
-}
-
-/* Declare a local entity.
-
-   Retrieves or creates the ffesymbol for the specified local entity.
-   Set maybe_intrin TRUE if this name might turn out to name an
-   intrinsic (legitimately); otherwise if the name doesn't meet the
-   requirements for a user-defined symbol name, a diagnostic will be
-   issued right away rather than waiting until the intrinsicness of the
-   symbol is determined.  */
-
-ffesymbol
-ffesymbol_declare_local (ffelexToken t, bool maybe_intrin)
-{
-  ffename n;
-  ffesymbol s;
-
-  assert (t != NULL);
-
-  /* If we're parsing within a statement function definition, return the
-     symbol if already known (a dummy argument for the statement function).
-     Otherwise continue on, which means the symbol is declared within the
-     containing (local) program unit rather than the statement function
-     definition.  */
-
-  if ((ffesymbol_sfunc_ != NULL)
-      && ((n = ffename_lookup (ffesymbol_sfunc_, t)) != NULL))
-    return ffename_symbol (n);
-
-  n = ffename_find (ffesymbol_local_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      ffesymbol_check (s, t, maybe_intrin);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  ffesymbol_check (s, t, maybe_intrin);
-  return s;
-}
-
-/* Declare a main program unit.
-
-   Retrieves or creates the ffesymbol for the specified main program unit
-   (unnamed main program unit if t is NULL).  Doesn't actually ensure the
-   named item is a program; the caller must handle that.  */
-
-ffesymbol
-ffesymbol_declare_programunit (ffelexToken t, ffewhereLine wl,
-			       ffewhereColumn wc)
-{
-  ffename n;
-  ffesymbol s;
-  bool user = (t != NULL);
-
-  assert (!ffesymbol_retractable_);
-
-  if (t == NULL)
-    {
-      if (ffesymbol_token_unnamed_main_ == NULL)
-	ffesymbol_token_unnamed_main_
-	  = ffelex_token_new_name (FFETARGET_nameUNNAMED_MAIN, wl, wc);
-      t = ffesymbol_token_unnamed_main_;
-    }
-
-  n = ffename_lookup (ffesymbol_local_, t);
-  if (n != NULL)
-    return ffename_symbol (n);	/* This will become an error. */
-
-  n = ffename_find (ffesymbol_global_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      if (user)
-	ffesymbol_check (s, t, FALSE);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  if (user)
-    ffesymbol_check (s, t, FALSE);
-
-  /* A program unit name also is in the local name space. */
-
-  n = ffename_find (ffesymbol_local_, t);
-  ffename_set_symbol (n, s);
-  s->other_space_name = n;
-
-  ffeglobal_new_program (s, t);	/* Detect conflicts. */
-
-  return s;
-}
-
-/* Declare a statement-function dummy.
-
-   Retrieves or creates the ffesymbol for the specified statement
-   function dummy.  Also ensures that it has a link to the parent (local)
-   ffesymbol with the same name, creating it if necessary.  */
-
-ffesymbol
-ffesymbol_declare_sfdummy (ffelexToken t)
-{
-  ffename n;
-  ffesymbol s;
-  ffesymbol sp;			/* Parent symbol in local area. */
-
-  assert (t != NULL);
-
-  n = ffename_find (ffesymbol_local_, t);
-  sp = ffename_symbol (n);
-  if (sp == NULL)
-    sp = ffesymbol_new_ (n);
-  ffesymbol_check (sp, t, FALSE);
-
-  n = ffename_find (ffesymbol_sfunc_, t);
-  s = ffename_symbol (n);
-  if (s == NULL)
-    {
-      s = ffesymbol_new_ (n);
-      s->sfa_dummy_parent = sp;
-    }
-  else
-    assert (s->sfa_dummy_parent == sp);
-
-  return s;
-}
-
-/* Declare a subroutine program unit.
-
-   Retrieves or creates the ffesymbol for the specified subroutine
-   Doesn't actually ensure the named item is a subroutine; the caller must
-   handle that.  */
-
-ffesymbol
-ffesymbol_declare_subrunit (ffelexToken t)
-{
-  ffename n;
-  ffesymbol s;
-
-  assert (!ffesymbol_retractable_);
-  assert (t != NULL);
-
-  n = ffename_lookup (ffesymbol_local_, t);
-  if (n != NULL)
-    return ffename_symbol (n);	/* This will become an error. */
-
-  n = ffename_find (ffesymbol_global_, t);
-  s = ffename_symbol (n);
-  if (s != NULL)
-    {
-      ffesymbol_check (s, t, FALSE);
-      return s;
-    }
-
-  s = ffesymbol_new_ (n);
-  ffesymbol_check (s, t, FALSE);
-
-  /* A program unit name also is in the local name space. */
-
-  n = ffename_find (ffesymbol_local_, t);
-  ffename_set_symbol (n, s);
-  s->other_space_name = n;
-
-  ffeglobal_new_subroutine (s, t);	/* Detect conflicts, when
-					   appropriate. */
-
-  return s;
-}
-
-/* Call given fn with all local/global symbols.
-
-   ffesymbol (*fn) (ffesymbol s);
-   ffesymbol_drive (fn);  */
-
-void
-ffesymbol_drive (ffesymbol (*fn) (ffesymbol))
-{
-  assert (ffesymbol_sfunc_ == NULL);	/* Might be ok, but not for current
-					   uses. */
-  ffename_space_drive_symbol (ffesymbol_local_, fn);
-  ffename_space_drive_symbol (ffesymbol_global_, fn);
-}
-
-/* Call given fn with all sfunc-only symbols.
-
-   ffesymbol (*fn) (ffesymbol s);
-   ffesymbol_drive_sfnames (fn);  */
-
-void
-ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol))
-{
-  ffename_space_drive_symbol (ffesymbol_sfunc_, fn);
-}
-
-/* Produce generic error message about a symbol.
-
-   For now, just output error message using symbol's name and pointing to
-   the token.  */
-
-void
-ffesymbol_error (ffesymbol s, ffelexToken t)
-{
-  if ((t != NULL)
-      && ffest_ffebad_start (FFEBAD_SYMERR))
-    {
-      ffebad_string (ffesymbol_text (s));
-      ffebad_here (0, ffelex_token_where_line (t),
-		   ffelex_token_where_column (t));
-      ffebad_here (1, ffesymbol_where_line (s), ffesymbol_where_column (s));
-      ffebad_finish ();
-    }
-
-  if (ffesymbol_attr (s, FFESYMBOL_attrANY))
-    return;
-
-  ffesymbol_signal_change (s);	/* May need to back up to previous version. */
-  if ((ffesymbol_attrs (s) & FFESYMBOL_attrsCBLOCK)
-      || (ffesymbol_kind (s) == FFEINFO_kindNAMELIST))
-    ffebld_end_list (ffesymbol_ptr_to_listbottom (s));
-  ffesymbol_set_attr (s, FFESYMBOL_attrANY);
-  ffesymbol_set_info (s, ffeinfo_new_any ());
-  ffesymbol_set_state (s, FFESYMBOL_stateUNDERSTOOD);
-  if (s->check_state == FFESYMBOL_checkstatePENDING_)
-    ffelex_token_kill (s->check_token);
-  s->check_state = FFESYMBOL_checkstateCHECKED_;
-  s = ffecom_sym_learned (s);
-  ffesymbol_signal_unreported (s);
-}
-
-void
-ffesymbol_init_0 (void)
-{
-  ffesymbolAttrs attrs = FFESYMBOL_attrsetNONE;
-
-  assert (FFESYMBOL_state == ARRAY_SIZE (ffesymbol_state_name_));
-  assert (FFESYMBOL_attr == ARRAY_SIZE (ffesymbol_attr_name_));
-  assert (attrs == FFESYMBOL_attrsetNONE);
-  attrs = ((ffesymbolAttrs) 1 << FFESYMBOL_attr);
-  assert (attrs != 0);
-}
-
-void
-ffesymbol_init_1 (void)
-{
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
-  ffesymbol_global_ = ffename_space_new (ffe_pool_file ());
-#endif
-}
-
-void
-ffesymbol_init_2 (void)
-{
-}
-
-void
-ffesymbol_init_3 (void)
-{
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
-  ffesymbol_global_ = ffename_space_new (ffe_pool_program_unit ());
-#endif
-  ffesymbol_local_ = ffename_space_new (ffe_pool_program_unit ());
-}
-
-void
-ffesymbol_init_4 (void)
-{
-  ffesymbol_sfunc_ = ffename_space_new (ffe_pool_program_unit ());
-}
-
-/* Look up a local entity.
-
-   Retrieves the ffesymbol for the specified local entity, or returns NULL
-   if no local entity by that name exists.  */
-
-ffesymbol
-ffesymbol_lookup_local (ffelexToken t)
-{
-  ffename n;
-  ffesymbol s;
-
-  assert (t != NULL);
-
-  n = ffename_lookup (ffesymbol_local_, t);
-  if (n == NULL)
-    return NULL;
-
-  s = ffename_symbol (n);
-  return s;			/* May be NULL here, too. */
-}
-
-/* Registers the symbol as one that is referenced by the
-   current program unit.  Currently applies only to
-   symbols known to have global interest (globals and
-   intrinsics).
-
-   s is the (global/intrinsic) symbol referenced; t is the
-   referencing token; explicit is TRUE if the reference
-   is, e.g., INTRINSIC FOO.  */
-
-void
-ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit)
-{
-  ffename gn;
-  ffesymbol gs = NULL;
-  ffeinfoKind kind;
-  ffeinfoWhere where;
-  bool okay;
-
-  if (ffesymbol_retractable_)
-    return;
-
-  if (t == NULL)
-    t = ffename_token (s->name);	/* Use the first reference in this program unit. */
-
-  kind = ffesymbol_kind (s);
-  where = ffesymbol_where (s);
-
-  if (where == FFEINFO_whereINTRINSIC)
-    {
-      ffeglobal_ref_intrinsic (s, t,
-			       explicit
-			       || s->explicit_where
-			       || ffeintrin_is_standard (s->generic, s->specific));
-      return;
-    }
-
-  if ((where != FFEINFO_whereGLOBAL)
-      && ((where != FFEINFO_whereLOCAL)
-	  || ((kind != FFEINFO_kindFUNCTION)
-	      && (kind != FFEINFO_kindSUBROUTINE))))
-    return;
-
-  gn = ffename_lookup (ffesymbol_global_, t);
-  if (gn != NULL)
-    gs = ffename_symbol (gn);
-  if ((gs != NULL) && (gs != s))
-    {
-      /* We have just discovered another global symbol with the same name
-	 but a different `nature'.  Complain.  Note that COMMON /FOO/ can
-	 coexist with local symbol FOO, e.g. local variable, just not with
-	 CALL FOO, hence the separate namespaces.  */
-
-      ffesymbol_error (gs, t);
-      ffesymbol_error (s, NULL);
-      return;
-    }
-
-  switch (kind)
-    {
-    case FFEINFO_kindBLOCKDATA:
-      okay = ffeglobal_ref_blockdata (s, t);
-      break;
-
-    case FFEINFO_kindSUBROUTINE:
-      okay = ffeglobal_ref_subroutine (s, t);
-      break;
-
-    case FFEINFO_kindFUNCTION:
-      okay = ffeglobal_ref_function (s, t);
-      break;
-
-    case FFEINFO_kindNONE:
-      okay = ffeglobal_ref_external (s, t);
-      break;
-
-    default:
-      assert ("bad kind in global ref" == NULL);
-      return;
-    }
-
-  if (! okay)
-    ffesymbol_error (s, NULL);
-}
-
-/* Resolve symbol that has become known intrinsic or non-intrinsic.  */
-
-void
-ffesymbol_resolve_intrin (ffesymbol s)
-{
-  char c;
-  ffebad bad;
-
-  if (!ffesrc_check_symbol ())
-    return;
-  if (s->check_state != FFESYMBOL_checkstatePENDING_)
-    return;
-  if (ffebad_inhibit ())
-    return;			/* We'll get back to this later. */
-
-  if (ffesymbol_where (s) != FFEINFO_whereINTRINSIC)
-    {
-      bad = ffesymbol_check_token_ (s->check_token, &c);
-      assert (bad != FFEBAD);	/* How did this suddenly become ok? */
-      ffesymbol_whine_state_ (bad, s->check_token, c);
-    }
-
-  s->check_state = FFESYMBOL_checkstateCHECKED_;
-  ffelex_token_kill (s->check_token);
-}
-
-/* Retract or cancel retract list.  */
-
-void
-ffesymbol_retract (bool retract)
-{
-  ffesymbolRetract_ r;
-  ffename name;
-  ffename other_space_name;
-  ffesymbol ls;
-  ffesymbol os;
-
-  assert (ffesymbol_retractable_);
-
-  ffesymbol_retractable_ = FALSE;
-
-  for (r = ffesymbol_retract_first_; r != NULL; r = r->next)
-    {
-      ls = r->live;
-      os = r->symbol;
-      switch (r->command)
-	{
-	case FFESYMBOL_retractcommandDELETE_:
-	  if (retract)
-	    {
-	      ffecom_sym_retract (ls);
-	      name = ls->name;
-	      other_space_name = ls->other_space_name;
-	      ffesymbol_unhook_ (ls);
-	      malloc_kill_ks (FFESYMBOL_SPACE_POOL_, ls, sizeof (*ls));
-	      if (name != NULL)
-		ffename_set_symbol (name, NULL);
-	      if (other_space_name != NULL)
-		ffename_set_symbol (other_space_name, NULL);
-	    }
-	  else
-	    {
-	      ffecom_sym_commit (ls);
-	      ls->have_old = FALSE;
-	    }
-	  break;
-
-	case FFESYMBOL_retractcommandRETRACT_:
-	  if (retract)
-	    {
-	      ffecom_sym_retract (ls);
-	      ffesymbol_unhook_ (ls);
-	      *ls = *os;
-	      malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os));
-	    }
-	  else
-	    {
-	      ffecom_sym_commit (ls);
-	      ffesymbol_unhook_ (os);
-	      malloc_kill_ks (FFESYMBOL_SPACE_POOL_, os, sizeof (*os));
-	      ls->have_old = FALSE;
-	    }
-	  break;
-
-	default:
-	  assert ("bad command" == NULL);
-	  break;
-	}
-    }
-}
-
-/* Return retractable flag.  */
-
-bool
-ffesymbol_retractable (void)
-{
-  return ffesymbol_retractable_;
-}
-
-/* Set retractable flag, retract pool.
-
-   Between this call and ffesymbol_retract, any changes made to existing
-   symbols cause the previous versions of those symbols to be saved, and any
-   newly created symbols to have their previous nonexistence saved.  When
-   ffesymbol_retract is called, this information either is used to retract
-   the changes and new symbols, or is discarded.  */
-
-void
-ffesymbol_set_retractable (mallocPool pool)
-{
-  assert (!ffesymbol_retractable_);
-
-  ffesymbol_retractable_ = TRUE;
-  ffesymbol_retract_pool_ = pool;
-  ffesymbol_retract_list_ = &ffesymbol_retract_first_;
-  ffesymbol_retract_first_ = NULL;
-}
-
-/* Existing symbol about to be changed; save?
-
-   Call this function before changing a symbol if it is possible that
-   the current actions may need to be undone (i.e. one of several possible
-   statement forms are being used to analyze the current system).
-
-   If the "retractable" flag is not set, just return.
-   Else, if the symbol's "have_old" flag is set, just return.
-   Else, make a copy of the symbol and add it to the "retract" list, set
-   the "have_old" flag, and return.  */
-
-void
-ffesymbol_signal_change (ffesymbol s)
-{
-  ffesymbolRetract_ r;
-  ffesymbol sym;
-
-  if (!ffesymbol_retractable_ || s->have_old)
-    return;
-
-  r = malloc_new_kp (ffesymbol_retract_pool_, "FFESYMBOL retract",
-		     sizeof (*r));
-  r->next = NULL;
-  r->command = FFESYMBOL_retractcommandRETRACT_;
-  r->live = s;
-  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);
-  if (s->check_state == FFESYMBOL_checkstatePENDING_)
-    sym->check_token = ffelex_token_use (s->check_token);
-
-  *ffesymbol_retract_list_ = r;
-  ffesymbol_retract_list_ = &r->next;
-
-  s->have_old = TRUE;
-}
-
-/* Returns the string based on the state.  */
-
-const char *
-ffesymbol_state_string (ffesymbolState state)
-{
-  if (state >= ARRAY_SIZE (ffesymbol_state_name_))
-    return "?\?\?";
-  return ffesymbol_state_name_[state];
-}
-
-void
-ffesymbol_terminate_0 (void)
-{
-}
-
-void
-ffesymbol_terminate_1 (void)
-{
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalFILE_
-  ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_);
-  ffename_space_kill (ffesymbol_global_);
-  ffesymbol_global_ = NULL;
-
-  ffesymbol_kill_manifest_ ();
-#endif
-}
-
-void
-ffesymbol_terminate_2 (void)
-{
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
-  ffesymbol_kill_manifest_ ();
-#endif
-}
-
-void
-ffesymbol_terminate_3 (void)
-{
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
-  ffename_space_drive_symbol (ffesymbol_global_, ffesymbol_unhook_);
-  ffename_space_kill (ffesymbol_global_);
-#endif
-  ffename_space_drive_symbol (ffesymbol_local_, ffesymbol_unhook_);
-  ffename_space_kill (ffesymbol_local_);
-#if FFESYMBOL_globalCURRENT_ == FFESYMBOL_globalPROGUNIT_
-  ffesymbol_global_ = NULL;
-#endif
-  ffesymbol_local_ = NULL;
-}
-
-void
-ffesymbol_terminate_4 (void)
-{
-  ffename_space_drive_symbol (ffesymbol_sfunc_, ffesymbol_unhook_);
-  ffename_space_kill (ffesymbol_sfunc_);
-  ffesymbol_sfunc_ = NULL;
-}
-
-/* Update INIT info to TRUE and all equiv/storage too.
-
-   If INIT flag is TRUE, does nothing.	Else sets it to TRUE and calls
-   on the ffeequiv and ffestorag modules to update their INIT flags if
-   the <s> symbol has those objects, and also updates the common area if
-   it exists.  */
-
-void
-ffesymbol_update_init (ffesymbol s)
-{
-  ffebld item;
-
-  if (s->is_init)
-    return;
-
-  s->is_init = TRUE;
-
-  if ((s->equiv != NULL)
-      && !ffeequiv_is_init (s->equiv))
-    ffeequiv_update_init (s->equiv);
-
-  if ((s->storage != NULL)
-      && !ffestorag_is_init (s->storage))
-    ffestorag_update_init (s->storage);
-
-  if ((s->common != NULL)
-      && (!ffesymbol_is_init (s->common)))
-    ffesymbol_update_init (s->common);
-
-  for (item = s->common_list; item != NULL; item = ffebld_trail (item))
-    {
-      if (!ffesymbol_is_init (ffebld_symter (ffebld_head (item))))
-	ffesymbol_update_init (ffebld_symter (ffebld_head (item)));
-    }
-}
-
-/* Update SAVE info to TRUE and all equiv/storage too.
-
-   If SAVE flag is TRUE, does nothing.	Else sets it to TRUE and calls
-   on the ffeequiv and ffestorag modules to update their SAVE flags if
-   the <s> symbol has those objects, and also updates the common area if
-   it exists.  */
-
-void
-ffesymbol_update_save (ffesymbol s)
-{
-  ffebld item;
-
-  if (s->is_save)
-    return;
-
-  s->is_save = TRUE;
-
-  if ((s->equiv != NULL)
-      && !ffeequiv_is_save (s->equiv))
-    ffeequiv_update_save (s->equiv);
-
-  if ((s->storage != NULL)
-      && !ffestorag_is_save (s->storage))
-    ffestorag_update_save (s->storage);
-
-  if ((s->common != NULL)
-      && (!ffesymbol_is_save (s->common)))
-    ffesymbol_update_save (s->common);
-
-  for (item = s->common_list; item != NULL; item = ffebld_trail (item))
-    {
-      if (!ffesymbol_is_save (ffebld_symter (ffebld_head (item))))
-	ffesymbol_update_save (ffebld_symter (ffebld_head (item)));
-    }
-}
diff --git a/gcc/f/symbol.def b/gcc/f/symbol.def
deleted file mode 100644
index 9cddcb6..0000000
--- a/gcc/f/symbol.def
+++ /dev/null
@@ -1,654 +0,0 @@
-/* Definitions and documentations for attributes used in GNU F77 compiler
-   Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.  */
-
-/* "How g77 learns about symbols"
-
-   There are three primary things in a symbol that g77 uses to keep
-   track of what it has learned about that symbol:
-
-   1.  The state
-   2.  The attributes
-   3.  The info
-
-   State, attributes, and info (see f-info* files) all start out with
-   "NONE" fields when a symbol is first created.
-
-   In a PROGRAM or BLOCK DATA program unit, info where cannot be DUMMY
-   or RESULT.  Any combinations including those possibilities are not
-   considered possible in such program units.
-
-   As soon as a symbol is created, it _must_ have its state changed to
-   SEEN, UNCERTAIN, or UNDERSTOOD.
-
-   If SEEN, some info might be set, such as the type info (as in when
-   the TYPE attribute is present) or kind/where info.
-
-   If UNCERTAIN, the permitted combinations of attributes and info are
-   listed below.  Only the attributes ACTUALARG, ADJUSTABLE, ANYLEN, ARRAY,
-   DUMMY, EXTERNAL, SFARG, and TYPE are permitted.  (All these attributes
-   are contrasted to each attribute below, even though some combinations
-   wouldn't be permitted in SEEN state either.)  Note that DUMMY and
-   RESULT are not permitted in a PROGRAM/BLOCKDATA program unit, which
-   results in some of the combinations below not occurring (not UNCERTAIN,
-   but UNDERSTOOD).
-
-   ANYLEN|TYPE & ~(ACTUALARG|ADJUSTABLE|ARRAY|DUMMY|EXTERNAL|SFARG):
-	ENTITY/DUMMY, ENTITY/RESULT, FUNCTION/INTRINSIC.
-
-   ARRAY & ~(ACTUALARG|ANYLEN|DUMMY|EXTERNAL|SFARG|TYPE):
-	ENTITY/DUMMY, ENTITY/LOCAL.
-
-   ARRAY|TYPE & ~(ACTUALARG|ANYLEN|DUMMY|EXTERNAL|SFARG):
-	ENTITY/DUMMY, ENTITY/LOCAL.
-
-   DUMMY & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|EXTERNAL|SFARG|TYPE):
-	ENTITY/DUMMY, FUNCTION/DUMMY, SUBROUTINE/DUMMY.
-
-   DUMMY|TYPE & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|EXTERNAL|SFARG):
-	ENTITY/DUMMY, FUNCTION/DUMMY.
-
-   EXTERNAL & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|SFARG|TYPE):
-	FUNCTION/DUMMY, FUNCTION/GLOBAL, SUBROUTINE/DUMMY,
-	SUBROUTINE/GLOBAL, BLOCKDATA/GLOBAL.
-
-   EXTERNAL|ACTUALARG & ~(ADJUSTABLE|ANYLEN|ARRAY|DUMMY|SFARG|TYPE):
-	FUNCTION/GLOBAL, SUBROUTINE/GLOBAL.
-
-   EXTERNAL|DUMMY & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|SFARG|TYPE):
-	FUNCTION/DUMMY, SUBROUTINE/DUMMY.
-
-   EXTERNAL|TYPE & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|SFARG):
-	FUNCTION/DUMMY, FUNCTION/GLOBAL.
-
-   SFARG & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|EXTERNAL|TYPE):
-	ENTITY/DUMMY, ENTITY/LOCAL.
-
-   SFARG|TYPE & ~(ACTUALARG|ADJUSTABLE|ANYLEN|ARRAY|DUMMY|EXTERNAL):
-	ENTITY/DUMMY, ENTITY/LOCAL.
-
-   TYPE & ~(ACTUALARG|ANYLEN|ARRAY|DUMMY|EXTERNAL|SFARG):
-	ENTITY/DUMMY, ENTITY/LOCAL, ENTITY/RESULT, FUNCTION/DUMMY,
-	FUNCTION/GLOBAL, FUNCTION/INTRINSIC.
-
-   If UNDERSTOOD, the attributes are no longer considered, and the info
-   field is considered to be as fully filled in as possible by analyzing
-   a single program unit.
-
-   Each of the attributes (used only for SEEN/UNCERTAIN states) is
-   defined and described below.  In many cases, a symbol starts out as
-   SEEN and has attributes set as it is seen in various contexts prior
-   to the first executable statement being seen (the "exec transition").
-   Once that happens, either it becomes immediately UNDERSTOOD and all
-   its info filled in, or it becomes UNCERTAIN and its info only partially
-   filled in until it becomes UNDERSTOOD.  While UNCERTAIN, only a
-   subset of attributes are possible/important.
-
-   Not all symbols reach the UNDERSTOOD state, and in some cases symbols
-   go immediately from NONE to the UNDERSTOOD or even UNCERTAIN state.
-   For example, given "PROGRAM FOO", everything is known about the name
-   "FOO", so it becomes immediately UNDERSTOOD.
-
-   Also, there are multiple name spaces, and not all attributes are
-   possible/permitted in all name spaces.
-
-   The only attributes permitted in the global name space are:
-
-   ANY, CBLOCK, SAVECBLOCK.
-
-   The only attributes permitted in the local name space are:
-
-   ANY, ACTUALARG, ADJUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, ARRAY, COMMON,
-   DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT, SAVE, SFARG,
-   SFUNC, TYPE.
-
-   In the stmt-func name space, no attributes are used, just the states.
-
-*/
-
-
-/* Actual argument.  Always accompanied by EXTERNAL.
-
-   Context is a name used as an actual argument passed to a procedure
-   other than a statement function.
-
-   Valid in UNCERTAIN state and local name space only.
-
-   This attribute is used only to flag the fact that an EXTERNAL'ed name
-   has been seen as an actual argument, and therefore cannot be
-   discovered later to be a DUMMY argument (via an ENTRY statement).
-
-   If DUMMY + EXTERNAL already, it is permitted to see the name
-   as an actual argument, but ACTUALARG is not added as an attribute since
-   that fact does not improve knowledge about the name.  Hence it is not
-   permitted to transition ACTUALARG + EXTERNAL += DUMMY, and the
-   transition DUMMY + EXTERNAL += ACTUALARG is not actually done.
-
-   Cannot be combined with: ANYLEN, ARRAY, DUMMY, SFARG, TYPE.
-
-   Can be combined with: ACTUALARG, ANY, EXTERNAL.
-
-   Unrelated: ADJUSTABLE, ADJUSTS, ANYSIZE, CBLOCK, COMMON, EQUIV, INIT,
-   INTRINSIC, NAMELIST, RESULT, SAVE, SAVECBLOCK, SFUNC.
-
-*/
-
-DEFATTR (FFESYMBOL_attrACTUALARG, FFESYMBOL_attrsACTUALARG, "ACTUALARG")
-#ifndef FFESYMBOL_attrsACTUALARG
-#define FFESYMBOL_attrsACTUALARG ((ffesymbolAttrs) 1 << FFESYMBOL_attrACTUALARG)
-#endif
-
-/* Has adjustable dimension(s).  Always accompanied by ARRAY.
-
-   Context is an ARRAY-attributed name with an adjustable dimension (at
-   least one dimension containing a variable reference).
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ADJUSTS, COMMON, EQUIV, EXTERNAL,
-   NAMELIST, INIT, INTRINSIC, RESULT, SAVE, SFARG, SFUNC.
-
-   Can be combined with: ANY, ANYLEN, ANYSIZE, ARRAY, TYPE.
-
-   Must be combined with: DUMMY.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrADJUSTABLE, FFESYMBOL_attrsADJUSTABLE, "ADJUSTABLE")
-#ifndef FFESYMBOL_attrsADJUSTABLE
-#define FFESYMBOL_attrsADJUSTABLE ((ffesymbolAttrs) 1 << FFESYMBOL_attrADJUSTABLE)
-#endif
-
-/* Adjusts an array.
-
-   Context is an expression in an array declarator, such as in a
-   DIMENSION, COMMON, or type-specification statement.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, ARRAY,
-   EXTERNAL, INTRINSIC, RESULT, SAVE, SFUNC.
-
-   Can be combined with: ADJUSTS, ANY, COMMON, DUMMY, EQUIV, INIT,
-   NAMELIST, SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrADJUSTS, FFESYMBOL_attrsADJUSTS, "ADJUSTS")
-#ifndef FFESYMBOL_attrsADJUSTS
-#define FFESYMBOL_attrsADJUSTS ((ffesymbolAttrs) 1 << FFESYMBOL_attrADJUSTS)
-#endif
-
-/* Can be anything now, diagnostic has been issued at least once.
-
-   Valid in UNDERSTOOD state only.  Valid in any name space.
-
-   Can be combined with anything.
-
-*/
-
-DEFATTR (FFESYMBOL_attrANY, FFESYMBOL_attrsANY, "ANY")
-#ifndef FFESYMBOL_attrsANY
-#define FFESYMBOL_attrsANY ((ffesymbolAttrs) 1 << FFESYMBOL_attrANY)
-#endif
-
-/* Assumed (any) length.  Always accompanied by TYPE.
-
-   Context is a name listed in a CHARACTER statement and given a length
-   specification of (*).
-
-   Valid in SEEN and UNCERTAIN states.  Valid in local name space only.
-
-   In SEEN state, attributes marked below with "=" are unrelated.
-
-   In UNCERTAIN state, attributes marked below with "+" are unrelated,
-   attributes marked below with "-" cannot be combined with ANYLEN,
-   and attributes marked below with "!" transition to state UNDERSTOOD
-   instead of acquiring the new attribute.  Any other subsequent mentioning
-   of the name transitions to state UNDERSTOOD.  UNCERTAIN state is not
-   valid for this attribute in PROGRAM/BLOCKDATA program unit.
-
-   Cannot be combined with: ACTUALARG=, ADJUSTS+, ANYLEN, COMMON+, EQUIV+,
-   EXTERNAL, INIT+, INTRINSIC+, NAMELIST+, SAVE+, SFARG, SFUNC+.
-
-   Can be combined with: ADJUSTABLE+, ANY, ANYSIZE+, ARRAY-, DUMMY!, RESULT+,
-   TYPE.
-
-   Unrelated: CBLOCK, SAVECBLOCK.
-
-   In PROGRAM/BLOCKDATA, cannot be combined with ARRAY.
-
-*/
-
-DEFATTR (FFESYMBOL_attrANYLEN, FFESYMBOL_attrsANYLEN, "ANYLEN")
-#ifndef FFESYMBOL_attrsANYLEN
-#define FFESYMBOL_attrsANYLEN ((ffesymbolAttrs) 1 << FFESYMBOL_attrANYLEN)
-#endif
-
-/* Has assumed (any) size.  Always accompanied by ARRAY.
-
-   Context is an ARRAY-attributed name with its last dimension having
-   an upper bound of "*".
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTS, ANYSIZE, COMMON, EQUIV, EXTERNAL,
-   NAMELIST, INIT, INTRINSIC, RESULT, SAVE, SFARG, SFUNC.
-
-   Can be combined with: ADJUSTABLE, ANY, ANYLEN, ARRAY, TYPE.
-
-   Must be combined with: DUMMY.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrANYSIZE, FFESYMBOL_attrsANYSIZE, "ANYSIZE")
-#ifndef FFESYMBOL_attrsANYSIZE
-#define FFESYMBOL_attrsANYSIZE ((ffesymbolAttrs) 1 << FFESYMBOL_attrANYSIZE)
-#endif
-
-/* Array.
-
-   Context is a name followed by an array declarator, such as in a
-   type-statement-decl, a DIMENSION statement, or a COMMON statement.
-
-   Valid in SEEN and UNCERTAIN states.  Valid in local name space only.
-
-   In SEEN state, attributes marked below with "=" are unrelated.
-
-   In UNCERTAIN state, attributes marked below with "+" are unrelated,
-   attributes marked below with "-" cannot be combined with ARRAY,
-   and attributes marked below with "!" transition to state UNDERSTOOD
-   instead of acquiring the new attribute.  Any other subsequent mentioning
-   of the name transitions to state UNDERSTOOD.  UNCERTAIN state is not
-   valid for this attribute in PROGRAM/BLOCKDATA program unit.
-
-   Cannot be combined with: ACTUALARG=, ADJUSTS+, ARRAY, EXTERNAL,
-   INTRINSIC+, RESULT+, SFARG, SFUNC+.
-
-   Can be combined with: ADJUSTABLE+, ANY, ANYLEN-, ANYSIZE+, COMMON+,
-   DUMMY!, EQUIV+, INIT+, NAMELIST+, SAVE+, TYPE.
-
-   Unrelated: CBLOCK, SAVECBLOCK.
-
-   In PROGRAM/BLOCKDATA, cannot be combined with ANYLEN.
-   Cannot follow INIT.
-
-*/
-
-DEFATTR (FFESYMBOL_attrARRAY, FFESYMBOL_attrsARRAY, "ARRAY")
-#ifndef FFESYMBOL_attrsARRAY
-#define FFESYMBOL_attrsARRAY ((ffesymbolAttrs) 1 << FFESYMBOL_attrARRAY)
-#endif
-
-/* COMMON block.
-
-   Context is a name enclosed in slashes in a COMMON statement.
-
-   Valid in SEEN state and global name space only.
-
-   Cannot be combined with:
-
-   Can be combined with: CBLOCK, SAVECBLOCK.
-
-   Unrelated: ACTUALARG, ADJUSTABLE, ADJUSTS, ANY, ANYLEN, ANYSIZE,
-   ARRAY, COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST,
-   RESULT, SAVE, SFARG, SFUNC, TYPE.
-
-*/
-
-DEFATTR (FFESYMBOL_attrCBLOCK, FFESYMBOL_attrsCBLOCK, "CBLOCK")
-#ifndef FFESYMBOL_attrsCBLOCK
-#define FFESYMBOL_attrsCBLOCK ((ffesymbolAttrs) 1 << FFESYMBOL_attrCBLOCK)
-#endif
-
-/* Placed in COMMON.
-
-   Context is a name listed in a COMMON statement but not enclosed in
-   slashes.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, COMMON, DUMMY,
-   EXTERNAL, INTRINSIC, RESULT, SAVE, SFUNC.
-
-   Can be combined with: ADJUSTS, ANY, ARRAY, EQUIV, INIT, NAMELIST,
-   SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrCOMMON, FFESYMBOL_attrsCOMMON, "COMMON")
-#ifndef FFESYMBOL_attrsCOMMON
-#define FFESYMBOL_attrsCOMMON ((ffesymbolAttrs) 1 << FFESYMBOL_attrCOMMON)
-#endif
-
-/* Dummy argument.
-
-   Context is a name listed in the arglist of FUNCTION, SUBROUTINE, ENTRY.
-   (Statement-function definitions have dummy arguments, but since they're
-   the only possible entities in the statement-function name space, this
-   attribution mechanism isn't used for them.)
-
-   Valid in SEEN and UNCERTAIN states.  Valid in local name space only.
-
-   In SEEN state, attributes marked below with "=" are unrelated.
-
-   In UNCERTAIN state, attributes marked below with "+" are unrelated,
-   attributes marked below with "-" cannot be combined with DUMMY,
-   and attributes marked below with "!" transition to state UNDERSTOOD
-   instead of acquiring the new attribute.  Any other subsequent mentioning
-   of the name transitions to state UNDERSTOOD.  UNCERTAIN state is not
-   valid for this attribute in PROGRAM/BLOCKDATA program unit.
-
-   Cannot be combined with: ACTUALARG=, COMMON+, EQUIV+, INIT+, INTRINSIC+,
-   NAMELIST+, RESULT+, SAVE+, SFUNC+.
-
-   Can be combined with: ADJUSTABLE+, ADJUSTS+, ANY, ANYLEN-, ANYSIZE+,
-   ARRAY-, DUMMY, EXTERNAL, SFARG-, TYPE.
-
-   Unrelated: CBLOCK, SAVECBLOCK.
-
-   VXT Fortran disallows DUMMY + NAMELIST.
-   F90 allows DUMMY + NAMELIST (with some restrictions), g77 doesn't yet.
-
-*/
-
-DEFATTR (FFESYMBOL_attrDUMMY, FFESYMBOL_attrsDUMMY, "DUMMY")
-#ifndef FFESYMBOL_attrsDUMMY
-#define FFESYMBOL_attrsDUMMY ((ffesymbolAttrs) 1 << FFESYMBOL_attrDUMMY)
-#endif
-
-/* EQUIVALENCE'd.
-
-   Context is a name given in an EQUIVALENCE statement.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, DUMMY,
-   EXTERNAL, INTRINSIC, RESULT, SFUNC.
-
-   Can be combined with: ADJUSTS, ANY, ARRAY, COMMON, EQUIV, INIT,
-   NAMELIST, SAVE, SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrEQUIV, FFESYMBOL_attrsEQUIV, "EQUIV")
-#ifndef FFESYMBOL_attrsEQUIV
-#define FFESYMBOL_attrsEQUIV ((ffesymbolAttrs) 1 << FFESYMBOL_attrEQUIV)
-#endif
-
-/* EXTERNAL.
-
-   Context is a name listed in an EXTERNAL statement.
-
-   Valid in SEEN and UNCERTAIN states.  Valid in local name space only.
-
-   In SEEN state, attributes marked below with "=" are unrelated.
-
-   In UNCERTAIN state, attributes marked below with "+" are unrelated,
-   attributes marked below with "-" cannot be combined with EXTERNAL,
-   and attributes marked below with "!" transition to state UNDERSTOOD
-   instead of acquiring the new attribute.  Many other subsequent mentionings
-   of the name transitions to state UNDERSTOOD.  UNCERTAIN state is not
-   valid for this attribute in PROGRAM/BLOCKDATA program unit.
-
-   Cannot be combined with: ADJUSTABLE+, ADJUSTS+, ANYLEN, ANYSIZE+,
-   ARRAY, COMMON+, EQUIV+, EXTERNAL, INIT+, INTRINSIC+, NAMELIST+, RESULT+,
-   SAVE+, SFARG, SFUNC+.
-
-   Can be combined with: ACTUALARG=, ANY, DUMMY, TYPE.
-
-   Unrelated: CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrEXTERNAL, FFESYMBOL_attrsEXTERNAL, "EXTERNAL")
-#ifndef FFESYMBOL_attrsEXTERNAL
-#define FFESYMBOL_attrsEXTERNAL ((ffesymbolAttrs) 1 << FFESYMBOL_attrEXTERNAL)
-#endif
-
-/* Given an initial value.
-
-   Context is a name listed in a type-def-stmt such as INTEGER or REAL
-   and given an initial value or values.  Someday will also include
-   names in DATA statements, which currently immediately exec-transition
-   their targets.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, DUMMY, EXTERNAL,
-   INIT, INTRINSIC, RESULT, SFUNC.
-
-   Can be combined with: ADJUSTS, ANY, ARRAY, COMMON, EQUIV, NAMELIST,
-   SAVE, SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-   Cannot be followed by ARRAY.
-
-*/
-
-DEFATTR (FFESYMBOL_attrINIT, FFESYMBOL_attrsINIT, "INIT")
-#ifndef FFESYMBOL_attrsINIT
-#define FFESYMBOL_attrsINIT ((ffesymbolAttrs) 1 << FFESYMBOL_attrINIT)
-#endif
-
-/* INTRINSIC.
-
-   Context is a name listed in an INTRINSIC statement.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, ARRAY,
-   COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT,
-   SAVE, SFARG, SFUNC.
-
-   Can be combined with: ANY, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrINTRINSIC, FFESYMBOL_attrsINTRINSIC, "INTRINSIC")
-#ifndef FFESYMBOL_attrsINTRINSIC
-#define FFESYMBOL_attrsINTRINSIC ((ffesymbolAttrs) 1 << FFESYMBOL_attrINTRINSIC)
-#endif
-
-/* NAMELISTed.
-
-   Context is a name listed in a NAMELIST statement but not enclosed in
-   slashes.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ANYLEN, ANYSIZE, DUMMY, EXTERNAL,
-   INTRINSIC, RESULT, SFUNC.
-
-   Can be combined with: ADJUSTS, ANY, ARRAY, COMMON, EQUIV, INIT,
-   NAMELIST, SAVE, SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrNAMELIST, FFESYMBOL_attrsNAMELIST, "NAMELIST")
-#ifndef FFESYMBOL_attrsNAMELIST
-#define FFESYMBOL_attrsNAMELIST ((ffesymbolAttrs) 1 << FFESYMBOL_attrNAMELIST)
-#endif
-
-/* RESULT of a function.
-
-   Context is name in RESULT() clause in FUNCTION or ENTRY statement, or
-   the name in a FUNCTION or ENTRY statement (within a FUNCTION subprogram)
-   that has no RESULT() clause.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ADJUSTS, ANYSIZE, ARRAY, COMMON,
-   DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT, SAVE, SFUNC.
-
-   Can be combined with: ANY, ANYLEN, SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-   Cannot be preceded by SFARG.
-
-*/
-
-DEFATTR (FFESYMBOL_attrRESULT, FFESYMBOL_attrsRESULT, "RESULT")
-#ifndef FFESYMBOL_attrsRESULT
-#define FFESYMBOL_attrsRESULT ((ffesymbolAttrs) 1 << FFESYMBOL_attrRESULT)
-#endif
-
-/* SAVEd (not enclosed in slashes).
-
-   Context is a name listed in a SAVE statement but not enclosed in slashes.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, COMMON,
-   DUMMY, EXTERNAL, INTRINSIC, RESULT, SAVE, SFUNC.
-
-   Can be combined with: ANY, ARRAY, EQUIV, INIT, NAMELIST,
-   SFARG, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrSAVE, FFESYMBOL_attrsSAVE, "SAVE")
-#ifndef FFESYMBOL_attrsSAVE
-#define FFESYMBOL_attrsSAVE ((ffesymbolAttrs) 1 << FFESYMBOL_attrSAVE)
-#endif
-
-/* SAVEd (enclosed in slashes).
-
-   Context is a name enclosed in slashes in a SAVE statement.
-
-   Valid in SEEN state and global name space only.
-
-   Cannot be combined with: SAVECBLOCK.
-
-   Can be combined with: CBLOCK.
-
-   Unrelated: ACTUALARG, ADJUSTABLE, ADJUSTS, ANY, ANYLEN, ANYSIZE,
-   ARRAY, COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST,
-   RESULT, SAVE, SFARG, SFUNC, TYPE.
-
-*/
-
-DEFATTR (FFESYMBOL_attrSAVECBLOCK, FFESYMBOL_attrsSAVECBLOCK, "SAVECBLOCK")
-#ifndef FFESYMBOL_attrsSAVECBLOCK
-#define FFESYMBOL_attrsSAVECBLOCK ((ffesymbolAttrs) 1 << FFESYMBOL_attrSAVECBLOCK)
-#endif
-
-/* Name used as a statement function arg or DATA implied-DO iterator.
-
-   Context is a name listed in the arglist of statement-function-definition
-   or as the iterator in an implied-DO construct in a DATA statement.
-
-   Valid in SEEN and UNCERTAIN states.  Valid in local name space only.
-
-   In SEEN state, attributes marked below with "=" are unrelated.
-
-   In UNCERTAIN state, attributes marked below with "+" are unrelated,
-   attributes marked below with "-" cannot be combined with SFARG,
-   and attributes marked below with "!" transition to state UNDERSTOOD
-   instead of acquiring the new attribute.  Any other subsequent mentioning
-   of the name transitions to state UNDERSTOOD.  UNCERTAIN state is not
-   valid for this attribute in PROGRAM/BLOCKDATA program unit.
-
-   Cannot be combined with: ACTUALARG=, ADJUSTABLE+, ANYLEN, ANYSIZE+,
-   ARRAY, EXTERNAL, INTRINSIC+, SFUNC+.
-
-   Can be combined with: ADJUSTS+, ANY, COMMON+, DUMMY!, EQUIV+, INIT+,
-   NAMELIST+, RESULT+, SAVE+, SFARG, TYPE.
-
-   Unrelated: CBLOCK, SAVECBLOCK.
-
-   Cannot be followed by RESULT.
-
-*/
-
-DEFATTR (FFESYMBOL_attrSFARG, FFESYMBOL_attrsSFARG, "SFARG")
-#ifndef FFESYMBOL_attrsSFARG
-#define FFESYMBOL_attrsSFARG ((ffesymbolAttrs) 1 << FFESYMBOL_attrSFARG)
-#endif
-
-/* Statement function name.
-
-   Context is a statement-function-definition statement, the name being
-   defined.
-
-   Valid in SEEN state and local name space only.
-
-   Cannot be combined with: ADJUSTABLE, ADJUSTS, ANYLEN, ANYSIZE, ARRAY,
-   COMMON, DUMMY, EQUIV, EXTERNAL, INIT, INTRINSIC, NAMELIST, RESULT,
-   SAVE, SFARG, SFUNC.
-
-   Can be combined with: ANY, TYPE.
-
-   Unrelated: ACTUALARG, CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrSFUNC, FFESYMBOL_attrsSFUNC, "SFUNC")
-#ifndef FFESYMBOL_attrsSFUNC
-#define FFESYMBOL_attrsSFUNC ((ffesymbolAttrs) 1 << FFESYMBOL_attrSFUNC)
-#endif
-
-/* Explicitly typed.
-
-   Context is a name listed in a type-def-stmt such as INTEGER or REAL.
-
-   Valid in SEEN and UNCERTAIN states.  Valid in local name space only.
-
-   In SEEN state, attributes marked below with "=" are unrelated.
-
-   In UNCERTAIN state, attributes marked below with "+" are unrelated,
-   attributes marked below with "-" cannot be combined with TYPE,
-   and attributes marked below with "!" transition to state UNDERSTOOD
-   instead of acquiring the new attribute.  Many other subsequent mentionings
-   of the name transitions to state UNDERSTOOD.  UNCERTAIN state is not
-   valid for this attribute in PROGRAM/BLOCKDATA program unit.
-
-   Cannot be combined with: ACTUALARG=, TYPE.
-
-   Can be combined with: ADJUSTABLE+, ADJUSTS+, ANY, ANYLEN, ANYSIZE+,
-   ARRAY, COMMON+, DUMMY, EQUIV+, EXTERNAL, INIT+, INTRINSIC+, NAMELIST+,
-   RESULT+, SAVE+, SFARG, SFUNC+.
-
-   Unrelated: CBLOCK, SAVECBLOCK.
-
-*/
-
-DEFATTR (FFESYMBOL_attrTYPE, FFESYMBOL_attrsTYPE, "TYPE")
-#ifndef FFESYMBOL_attrsTYPE
-#define FFESYMBOL_attrsTYPE ((ffesymbolAttrs) 1 << FFESYMBOL_attrTYPE)
-#endif
diff --git a/gcc/f/symbol.h b/gcc/f/symbol.h
deleted file mode 100644
index 7ddafbd..0000000
--- a/gcc/f/symbol.h
+++ /dev/null
@@ -1,287 +0,0 @@
-/* Interface definitions for Fortran symbol manager
-   Copyright (C) 1995, 1996, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.  */
-
-#ifndef GCC_F_SYMBOL_H
-#define GCC_F_SYMBOL_H
-
-/* The main symbol type.  */
-
-typedef struct _ffesymbol_ *ffesymbol;
-
-/* State of understanding about what the symbol represents.  */
-
-enum _ffesymbol_state_
-  {
-/* See ffesymbol_state_is_exec() macro below when making changes.  */
-    FFESYMBOL_stateNONE,	/* Never before seen. */
-    FFESYMBOL_stateSEEN,	/* Seen before exec transition and not yet
-				   understood (info not filled in, etc). */
-    FFESYMBOL_stateUNCERTAIN,	/* Almost understood (info partly filled in). */
-    FFESYMBOL_stateUNDERSTOOD,	/* Fully understood (info filled in). */
-    FFESYMBOL_state
-  };
-typedef enum _ffesymbol_state_ ffesymbolState;
-#define ffesymbolState_f ""
-
-/* Attributes.  Symbols acquire attributes while their state is SEEN.
-   These attributes are basically ignored once the symbol becomes
-   UNDERSTOOD.  */
-
-typedef long int ffesymbolAttrs;/* Holds set of attributes. */
-#define ffesymbolAttrs_f "l"
-
-enum _ffesymbol_attr_
-  {
-#define DEFATTR(ATTR,ATTRS,NAME) ATTR,
-#include "symbol.def"
-#undef DEFATTR
-    FFESYMBOL_attr
-  };				/* A given attribute. */
-typedef enum _ffesymbol_attr_ ffesymbolAttr;
-#define ffesymbolAttr_f ""
-
-#define FFESYMBOL_attrsetNONE 0
-#define FFESYMBOL_attrsetALL (((ffesymbolAttrs) 1 << FFESYMBOL_attr) - 1)
-
-/* This is just for avoiding complaining about, e.g., "I = IABS(3)", that
-   IABS doesn't meet the requirements for a user-defined symbol name as
-   a result of, say, --symbol-case-lower, if IABS turns out to indeed be
-   a reference to the intrinsic IABS (in which case it's a Fortran keyword
-   like CALL) and not a user-defined name.  */
-
-enum _ffesymbol_checkstate_
-  {
-    FFESYMBOL_checkstateNONE_,	/* Not checked/never necessary to check. */
-    FFESYMBOL_checkstateINHIBITED_,	/* Bad name, but inhibited. */
-    FFESYMBOL_checkstatePENDING_,	/* Bad name, might be intrinsic. */
-    FFESYMBOL_checkstateCHECKED_,	/* Ok name, intrinsic, or bad name
-					   reported. */
-    FFESYMBOL_checkstate_
-  };
-typedef enum _ffesymbol_checkstate_ ffesymbolCheckState_;
-#define ffesymbolCheckState_f_ ""
-
-#include "bld.h"
-#include "com.h"
-#include "equiv.h"
-#include "global.h"
-#include "info.h"
-#include "intrin.h"
-#include "lex.h"
-#include "malloc.h"
-#include "name.h"
-#include "storag.h"
-#include "target.h"
-#include "top.h"
-#include "where.h"
-
-struct _ffesymbol_
-  {
-    ffename name;
-    ffename other_space_name;	/* For dual-space objects. */
-    ffeglobal global;		/* In filewide name space. */
-    ffesymbolAttrs attrs;	/* What kind of symbol am I? */
-    ffesymbolState state;	/* What state am I in? */
-    ffeinfo info;		/* Info filled in when _stateUNDERSTOOD. */
-    ffebld dims;		/* Dimension list expression. */
-    ffebld extents;		/* Extents list expression. */
-    ffebld dim_syms;		/* List of SYMTERs of all symbols in dims. */
-    ffebld array_size;		/* Size as an expression involving some of
-				   dims. */
-    ffebld init;		/* Initialization expression or expr list or
-				   PARAMETER value. */
-    ffebld accretion;		/* Initializations seen so far for
-				   array/substr. */
-    ffetargetOffset accretes;	/* # inits needed to fill entire array. */
-    ffebld dummy_args;		/* For functions, subroutines, and entry
-				   points. */
-    ffebld namelist;		/* List of symbols in NML. */
-    ffebld common_list;		/* List of entities in BCB/NCB. */
-    ffebld sfunc_expr;		/* SFN's expression. */
-    ffebldListBottom list_bottom;	/* For BCB, NCB, NML. */
-    ffesymbol common;		/* Who is my containing COMMON area? */
-    ffeequiv equiv;		/* Who have I been equivalenced with? */
-    ffestorag storage;		/* Where am I in relation to my outside
-				   world? */
-    ffecomSymbol hook;		/* Whatever the compiler/backend wants! */
-    ffesymbol sfa_dummy_parent;	/* "X" outside sfunc "CIRC(X) = 3.14 * X". */
-    ffesymbol func_result;	/* FUN sym's corresponding RES sym, & vice
-				   versa. */
-    ffetargetIntegerDefault value;	/* IMMEDIATE (DATA impdo) value. */
-    ffesymbolCheckState_ check_state;	/* Valid name? */
-    ffelexToken check_token;	/* checkstatePENDING_ only. */
-    int max_entry_num;		/* For detecting dummy arg listed twice/IMPDO
-				   iterator nesting violation; also for id of
-				   sfunc dummy arg. */
-    int num_entries;		/* Number of entry points in which this
-				   symbol appears as a dummy arg; helps
-				   determine whether arg might not be passed,
-				   for example.  */
-    ffeintrinGen generic;	/* Generic intrinsic id, if any. */
-    ffeintrinSpec specific;	/* Specific intrinsic id, if any. */
-    ffeintrinImp implementation;/* Implementation id, if any. */
-    bool is_save;		/* SAVE flag set for this symbol (see also
-				   ffe_is_saveall()). */
-    bool is_init;		/* INIT flag set for this symbol. */
-    bool do_iter;		/* Is currently a DO-loop iter (can't be
-				   changed in loop). */
-    bool reported;		/* (Debug) TRUE if the latest version has
-				   been reported. */
-    bool have_old;		/* TRUE if old copy of this symbol saved
-				   away. */
-    bool explicit_where;	/* TRUE if INTRINSIC/EXTERNAL explicit. */
-    bool namelisted;		/* TRUE if in NAMELIST (needs static alloc). */
-    bool assigned;		/* TRUE if ever ASSIGNed to.  */
-  };
-
-#define ffesymbol_accretes(s) ((s)->accretes)
-#define ffesymbol_accretion(s) ((s)->accretion)
-#define ffesymbol_arraysize(s) ((s)->array_size)
-#define ffesymbol_assigned(s) ((s)->assigned)
-#define ffesymbol_attr(s,a) ((s)->attrs & ((ffesymbolAttrs) 1 << (a)))
-#define ffesymbol_attrs(s) ((s)->attrs)
-const char *ffesymbol_attrs_string (ffesymbolAttrs attrs);
-#define ffesymbol_basictype(s) ffeinfo_basictype((s)->info)
-void ffesymbol_check (ffesymbol s, ffelexToken t, bool maybe_intrin);
-#define ffesymbol_common(s) ((s)->common)
-#define ffesymbol_commonlist(s) ((s)->common_list)
-ffesymbol ffesymbol_declare_blockdataunit (ffelexToken t, ffewhereLine wl,
-					   ffewhereColumn wc);
-ffesymbol ffesymbol_declare_cblock (ffelexToken t, ffewhereLine wl,
-				    ffewhereColumn wc);
-ffesymbol ffesymbol_declare_funcnotresunit (ffelexToken t);
-ffesymbol ffesymbol_declare_funcresult (ffelexToken t);
-ffesymbol ffesymbol_declare_funcunit (ffelexToken t);
-ffesymbol ffesymbol_declare_local (ffelexToken t, bool maybe_intrin);
-ffesymbol ffesymbol_declare_programunit (ffelexToken t, ffewhereLine wl,
-					 ffewhereColumn wc);
-ffesymbol ffesymbol_declare_sfdummy (ffelexToken t);
-ffesymbol ffesymbol_declare_subrunit (ffelexToken t);
-#define ffesymbol_dims(s) ((s)->dims)
-#define ffesymbol_dim_syms(s) ((s)->dim_syms)
-void ffesymbol_drive (ffesymbol (*fn) (ffesymbol));
-void ffesymbol_drive_sfnames (ffesymbol (*fn) (ffesymbol));
-#define ffesymbol_dummyargs(s) ((s)->dummy_args)
-void ffesymbol_error (ffesymbol s, ffelexToken t);
-#define ffesymbol_equiv(s) ((s)->equiv)
-#define ffesymbol_explicitwhere(s) ((s)->explicit_where)
-#define ffesymbol_extents(s) ((s)->extents)
-#define ffesymbol_first_token(s) ((s)->name == NULL ? NULL  \
-      : ffename_first_token((s)->name))
-#define ffesymbol_funcresult(s) ((s)->func_result)
-#define ffesymbol_generic(s) ((s)->generic)
-#define ffesymbol_global(s) ((s)->global)
-#define ffesymbol_hook(s) ((s)->hook)
-#define ffesymbol_implementation(s) ((s)->implementation)
-#define ffesymbol_info(s) ((s)->info)
-#define ffesymbol_init(s) ((s)->init)
-void ffesymbol_init_0 (void);
-void ffesymbol_init_1 (void);
-void ffesymbol_init_2 (void);
-void ffesymbol_init_3 (void);
-void ffesymbol_init_4 (void);
-#define ffesymbol_is_doiter(s) ((s)->do_iter)
-#define ffesymbol_is_dualspace(s) ((s)->other_space_name != NULL)
-#define ffesymbol_is_f2c(s) (ffe_is_f2c())
-#define ffesymbol_is_init(s) ((s)->is_init)
-#define ffesymbol_is_reported(s) ((s)->reported)
-#define ffesymbol_is_save(s) ((s)->is_save)
-#define ffesymbol_is_specable(s) ffesymbol_state_is_specable(s->state)
-#define ffesymbol_kindtype(s) ffeinfo_kindtype((s)->info)
-#define ffesymbol_kind(s) ffeinfo_kind((s)->info)
-ffesymbol ffesymbol_lookup_local (ffelexToken t);
-#define ffesymbol_maxentrynum(s) ((s)->max_entry_num)
-#define ffesymbol_name(s) ((s)->name)
-#define ffesymbol_namelist(s) ((s)->namelist)
-#define ffesymbol_namelisted(s) ((s)->namelisted)
-#define ffesymbol_numentries(s) ((s)->num_entries)
-#define ffesymbol_ptr_to_commonlist(s) (&(s)->common_list)
-#define ffesymbol_ptr_to_listbottom(s) (&(s)->list_bottom)
-#define ffesymbol_ptr_to_namelist(s) (&(s)->namelist)
-#define ffesymbol_rank(s) ffeinfo_rank((s)->info)
-void ffesymbol_reference (ffesymbol s, ffelexToken t, bool explicit);
-void ffesymbol_resolve_intrin (ffesymbol s);
-void ffesymbol_retract (bool retract);
-bool ffesymbol_retractable (void);
-#define ffesymbol_set_accretes(s,a) ((s)->accretes = (a))
-#define ffesymbol_set_accretion(s,a) ((s)->accretion = (a))
-#define ffesymbol_set_arraysize(s,a) ((s)->array_size = (a))
-#define ffesymbol_set_assigned(s,a) ((s)->assigned = (a))
-#define ffesymbol_set_attr(s,a) ((s)->attrs |= ((ffesymbolAttrs) 1 << (a)))
-#define ffesymbol_set_attrs(s,a) ((s)->attrs = (a))
-#define ffesymbol_set_common(s,c) ((s)->common = (c))
-#define ffesymbol_set_commonlist(s,c) ((s)->common_list = (c))
-#define ffesymbol_set_dims(s,d) ((s)->dims = (d))
-#define ffesymbol_set_dim_syms(s,d) ((s)->dim_syms = (d))
-#define ffesymbol_set_dummyargs(s,d) ((s)->dummy_args = (d))
-#define ffesymbol_set_equiv(s,e) ((s)->equiv = (e))
-#define ffesymbol_set_explicitwhere(s,e) ((s)->explicit_where = (e))
-#define ffesymbol_set_extents(s,e) ((s)->extents = (e))
-#define ffesymbol_set_funcresult(s,f) ((s)->func_result = (f))
-#define ffesymbol_set_generic(s,g) ((s)->generic = (g))
-#define ffesymbol_set_global(s,g) ((s)->global = (g))
-#define ffesymbol_set_hook(s,h) ((s)->hook = (h))
-#define ffesymbol_set_implementation(s,im) ((s)->implementation = (im))
-#define ffesymbol_set_init(s,i) ((s)->init = (i))
-#define ffesymbol_set_info(s,i) ((s)->info = (i))
-#define ffesymbol_set_is_doiter(s,f) ((s)->do_iter = (f))
-#define ffesymbol_set_is_init(s,in) ((s)->is_init = (in))
-#define ffesymbol_set_is_save(s,sa) ((s)->is_save = (sa))
-#define ffesymbol_set_maxentrynum(s,m) ((s)->max_entry_num = (m))
-#define ffesymbol_set_namelist(s,n) ((s)->namelist = (n))
-#define ffesymbol_set_namelisted(s,n) ((s)->namelisted = (n))
-#define ffesymbol_set_numentries(s,n) ((s)->num_entries = (n))
-void ffesymbol_set_retractable (mallocPool pool);
-#define ffesymbol_set_sfexpr(s,e) ((s)->sfunc_expr = (e))
-#define ffesymbol_set_specific(s,sp) ((s)->specific = (sp))
-#define ffesymbol_set_state(s,st) ((s)->state = (st))
-#define ffesymbol_set_storage(s,st) ((s)->storage = (st))
-#define ffesymbol_set_value(s,v) ((s)->value = (v))
-#define ffesymbol_sfdummyparent(s) ((s)->sfa_dummy_parent)
-#define ffesymbol_sfexpr(s) ((s)->sfunc_expr)
-void ffesymbol_signal_change (ffesymbol s);
-#define ffesymbol_signal_unreported(s) ((s)->reported = FALSE)
-#define ffesymbol_size(s) ffeinfo_size((s)->info)
-#define ffesymbol_specific(s) ((s)->specific)
-#define ffesymbol_state(s) ((s)->state)
-#define ffesymbol_state_is_specable(s) ((s) <= FFESYMBOL_stateSEEN)
-const char *ffesymbol_state_string (ffesymbolState state);
-#define ffesymbol_storage(s) ((s)->storage)
-void ffesymbol_terminate_0 (void);
-void ffesymbol_terminate_1 (void);
-void ffesymbol_terminate_2 (void);
-void ffesymbol_terminate_3 (void);
-void ffesymbol_terminate_4 (void);
-#define ffesymbol_text(s) (((s)->name == NULL) ? "<->" : ffename_text((s)->name))
-void ffesymbol_update_init (ffesymbol s);
-void ffesymbol_update_save (ffesymbol s);
-#define ffesymbol_value(s) ((s)->value)
-#define ffesymbol_where(s) ffeinfo_where((s)->info)
-#define ffesymbol_where_column(s) (((s)->name == NULL)	\
-      ? ffewhere_column_unknown() : ffename_where_column((s)->name))
-#define ffesymbol_where_filename(s) \
-      ffewhere_line_filename(ffesymbol_where_line(s))
-#define ffesymbol_where_filelinenum(s) \
-      ffewhere_line_filelinenum(ffesymbol_where_line(s))
-#define ffesymbol_where_line(s) (((s)->name == NULL) ? ffewhere_line_unknown() \
-      : ffename_where_line((s)->name))
-
-#endif /* ! GCC_F_SYMBOL_H */
diff --git a/gcc/f/target.c b/gcc/f/target.c
deleted file mode 100644
index 1626112..0000000
--- a/gcc/f/target.c
+++ /dev/null
@@ -1,2583 +0,0 @@
-/* target.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 1998, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None
-
-   Description:
-      Implements conversion of lexer tokens to machine-dependent numerical
-      form and accordingly issues diagnostic messages when necessary.
-
-      Also, this module, especially its .h file, provides nearly all of the
-      information on the target machine's data type, kind type, and length
-      type capabilities.  The idea is that by carefully going through
-      target.h and changing things properly, one can accomplish much
-      towards the porting of the FFE to a new machine.	There are limits
-      to how much this can accomplish towards that end, however.  For one
-      thing, the ffeexpr_collapse_convert function doesn't contain all the
-      conversion cases necessary, because the text file would be
-      enormous (even though most of the function would be cut during the
-      cpp phase because of the absence of the types), so when adding to
-      the number of supported kind types for a given type, one must look
-      to see if ffeexpr_collapse_convert needs modification in this area,
-      in addition to providing the appropriate macros and functions in
-      ffetarget.  Note that if combinatorial explosion actually becomes a
-      problem for a given machine, one might have to modify the way conversion
-      expressions are built so that instead of just one conversion expr, a
-      series of conversion exprs are built to make a path from one type to
-      another that is not a "near neighbor".  For now, however, with a handful
-      of each of the numeric types and only one character type, things appear
-      manageable.
-
-      A nonobvious change to ffetarget would be if the target machine was
-      not a 2's-complement machine.  Any item with the word "magical" (case-
-      insensitive) in the FFE's source code (at least) indicates an assumption
-      that a 2's-complement machine is the target, and thus that there exists
-      a magnitude that can be represented as a negative number but not as
-      a positive number.  It is possible that this situation can be dealt
-      with by changing only ffetarget, for example, on a 1's-complement
-      machine, perhaps #defineing ffetarget_constant_is_magical to simply
-      FALSE along with making the appropriate changes in ffetarget's number
-      parsing functions would be sufficient to effectively "comment out" code
-      in places like ffeexpr that do certain magical checks.  But it is
-      possible there are other 2's-complement dependencies lurking in the
-      FFE (as possibly is true of any large program); if you find any, please
-      report them so we can replace them with dependencies on ffetarget
-      instead.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "target.h"
-#include "diagnostic.h"
-#include "bad.h"
-#include "info.h"
-#include "lex.h"
-#include "malloc.h"
-#include "real.h"
-#include "toplev.h"
-
-/* Externals defined here. */
-
-char ffetarget_string_[40];	/* Temp for ascii-to-double (atof). */
-HOST_WIDE_INT ffetarget_long_val_;
-HOST_WIDE_INT ffetarget_long_junk_;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-static void ffetarget_print_char_ (FILE *f, unsigned char c);
-
-/* Internal macros. */
-
-
-
-/* ffetarget_print_char_ -- Print a single character (in apostrophe context)
-
-   See prototype.
-
-   Outputs char so it prints or is escaped C style.  */
-
-static void
-ffetarget_print_char_ (FILE *f, unsigned char c)
-{
-  switch (c)
-    {
-    case '\\':
-      fputs ("\\\\", f);
-      break;
-
-    case '\'':
-      fputs ("\\\'", f);
-      break;
-
-    default:
-      if (ISPRINT (c))
-	fputc (c, f);
-      else
-	fprintf (f, "\\%03o", (unsigned int) c);
-      break;
-    }
-}
-
-/* ffetarget_aggregate_info -- Determine type for aggregate storage area
-
-   See prototype.
-
-   If aggregate type is distinct, just return it.  Else return a type
-   representing a common denominator for the nondistinct type (for now,
-   just return default character, since that'll work on almost all target
-   machines).
-
-   The rules for abt/akt are (as implemented by ffestorag_update):
-
-   abt == FFEINFO_basictypeANY (akt == FFEINFO_kindtypeANY also, by
-   definition): CHARACTER and non-CHARACTER types mixed.
-
-   abt == FFEINFO_basictypeNONE (akt == FFEINFO_kindtypeNONE also, by
-   definition): More than one non-CHARACTER type mixed, but no CHARACTER
-   types mixed in.
-
-   abt some other value, akt == FFEINFO_kindtypeNONE: abt indicates the
-   only basic type mixed in, but more than one kind type is mixed in.
-
-   abt some other value, akt some other value: abt and akt indicate the
-   only type represented in the aggregation.  */
-
-void
-ffetarget_aggregate_info (ffeinfoBasictype *ebt, ffeinfoKindtype *ekt,
-			  ffetargetAlign *units, ffeinfoBasictype abt,
-			  ffeinfoKindtype akt)
-{
-  ffetype type;
-
-  if ((abt == FFEINFO_basictypeNONE) || (abt == FFEINFO_basictypeANY)
-      || (akt == FFEINFO_kindtypeNONE))
-    {
-      *ebt = FFEINFO_basictypeCHARACTER;
-      *ekt = FFEINFO_kindtypeCHARACTERDEFAULT;
-    }
-  else
-    {
-      *ebt = abt;
-      *ekt = akt;
-    }
-
-  type = ffeinfo_type (*ebt, *ekt);
-  assert (type != NULL);
-
-  *units = ffetype_size (type);
-}
-
-/* ffetarget_align -- Align one storage area to superordinate, update super
-
-   See prototype.
-
-   updated_alignment/updated_modulo contain the already existing
-   alignment requirements for the storage area at whose offset the
-   object with alignment requirements alignment/modulo is to be placed.
-   Find the smallest pad such that the requirements are maintained and
-   return it, but only after updating the updated_alignment/_modulo
-   requirements as necessary to indicate the placement of the new object.  */
-
-ffetargetAlign
-ffetarget_align (ffetargetAlign *updated_alignment,
-		 ffetargetAlign *updated_modulo, ffetargetOffset offset,
-		 ffetargetAlign alignment, ffetargetAlign modulo)
-{
-  ffetargetAlign pad;
-  ffetargetAlign min_pad;	/* Minimum amount of padding needed. */
-  ffetargetAlign min_m = 0;	/* Minimum-padding m. */
-  ffetargetAlign ua;		/* Updated alignment. */
-  ffetargetAlign um;		/* Updated modulo. */
-  ffetargetAlign ucnt;		/* Multiplier applied to ua. */
-  ffetargetAlign m;		/* Copy of modulo. */
-  ffetargetAlign cnt;		/* Multiplier applied to alignment. */
-  ffetargetAlign i;
-  ffetargetAlign j;
-
-  assert (alignment > 0);
-  assert (*updated_alignment > 0);
-  
-  assert (*updated_modulo < *updated_alignment);
-  assert (modulo < alignment);
-
-  /* The easy case: similar alignment requirements.  */
-  if (*updated_alignment == alignment)
-    {
-      if (modulo > *updated_modulo)
-	pad = alignment - (modulo - *updated_modulo);
-      else
-	pad = *updated_modulo - modulo;
-      if (offset < 0)
-	/* De-negatize offset, since % wouldn't do the expected thing.  */
-	offset = alignment - ((- offset) % alignment);
-      pad = (offset + pad) % alignment;
-      if (pad != 0)
-	pad = alignment - pad;
-      return pad;
-    }
-
-  /* Sigh, find LCM (Least Common Multiple) for the two alignment factors. */
-
-  for (ua = *updated_alignment, ucnt = 1;
-       ua % alignment != 0;
-       ua += *updated_alignment)
-    ++ucnt;
-
-  cnt = ua / alignment;
-
-  if (offset < 0)
-    /* De-negatize offset, since % wouldn't do the expected thing.  */
-    offset = ua - ((- offset) % ua);
-
-  /* Set to largest value.  */
-  min_pad = ~(ffetargetAlign) 0;
-
-  /* Find all combinations of modulo values the two alignment requirements
-     have; pick the combination that results in the smallest padding
-     requirement.  Of course, if a zero-pad requirement is encountered, just
-     use that one. */
-
-  for (um = *updated_modulo, i = 0; i < ucnt; um += *updated_alignment, ++i)
-    {
-      for (m = modulo, j = 0; j < cnt; m += alignment, ++j)
-	{
-	  /* This code is similar to the "easy case" code above. */
-	  if (m > um)
-	    pad = ua - (m - um);
-	  else
-	    pad = um - m;
-	  pad = (offset + pad) % ua;
-	  if (pad == 0)
-	    {
-	      /* A zero pad means we've got something useful.  */
-	      *updated_alignment = ua;
-	      *updated_modulo = um;
-	      return 0;
-	    }
-	  pad = ua - pad;
-	  if (pad < min_pad)
-	    {			/* New minimum padding value. */
-	      min_pad = pad;
-	      min_m = um;
-	    }
-	}
-    }
-
-  *updated_alignment = ua;
-  *updated_modulo = min_m;
-  return min_pad;
-}
-
-/* Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-bool
-ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
-		      mallocPool pool)
-{
-  val->length = ffelex_token_length (character);
-  if (val->length == 0)
-    val->text = NULL;
-  else
-    {
-      val->text = malloc_new_kp (pool, "ffetargetCharacter1", val->length + 1);
-      memcpy (val->text, ffelex_token_text (character), val->length);
-      val->text[val->length] = '\0';
-    }
-
-  return TRUE;
-}
-
-#endif
-/* Produce orderable comparison between two constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-int
-ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r)
-{
-  if (l.length < r.length)
-    return -1;
-  if (l.length > r.length)
-    return 1;
-  if (l.length == 0)
-    return 0;
-  return memcmp (l.text, r.text, l.length);
-}
-
-#endif
-/* ffetarget_concatenate_character1 -- Perform CONCAT op on two constants
-
-   Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_concatenate_character1 (ffetargetCharacter1 *res,
-	      ffetargetCharacter1 l, ffetargetCharacter1 r, mallocPool pool,
-				  ffetargetCharacterSize *len)
-{
-  res->length = *len = l.length + r.length;
-  if (*len == 0)
-    res->text = NULL;
-  else
-    {
-      res->text = malloc_new_kp (pool, "ffetargetCharacter1(CONCAT)", *len + 1);
-      if (l.length != 0)
-	memcpy (res->text, l.text, l.length);
-      if (r.length != 0)
-	memcpy (res->text + l.length, r.text, r.length);
-      res->text[*len] = '\0';
-    }
-
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_eq_character1 -- Perform relational comparison on char constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_eq_character1 (bool *res, ffetargetCharacter1 l,
-			 ffetargetCharacter1 r)
-{
-  assert (l.length == r.length);
-  *res = (memcmp (l.text, r.text, l.length) == 0);
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_le_character1 -- Perform relational comparison on char constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_le_character1 (bool *res, ffetargetCharacter1 l,
-			 ffetargetCharacter1 r)
-{
-  assert (l.length == r.length);
-  *res = (memcmp (l.text, r.text, l.length) <= 0);
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_lt_character1 -- Perform relational comparison on char constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_lt_character1 (bool *res, ffetargetCharacter1 l,
-			 ffetargetCharacter1 r)
-{
-  assert (l.length == r.length);
-  *res = (memcmp (l.text, r.text, l.length) < 0);
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_ge_character1 -- Perform relational comparison on char constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_ge_character1 (bool *res, ffetargetCharacter1 l,
-			 ffetargetCharacter1 r)
-{
-  assert (l.length == r.length);
-  *res = (memcmp (l.text, r.text, l.length) >= 0);
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_gt_character1 -- Perform relational comparison on char constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_gt_character1 (bool *res, ffetargetCharacter1 l,
-			 ffetargetCharacter1 r)
-{
-  assert (l.length == r.length);
-  *res = (memcmp (l.text, r.text, l.length) > 0);
-  return FFEBAD;
-}
-#endif
-
-#if FFETARGET_okCHARACTER1
-bool
-ffetarget_iszero_character1 (ffetargetCharacter1 constant)
-{
-  ffetargetCharacterSize i;
-
-  for (i = 0; i < constant.length; ++i)
-    if (constant.text[i] != 0)
-      return FALSE;
-  return TRUE;
-}
-#endif
-
-bool
-ffetarget_iszero_hollerith (ffetargetHollerith constant)
-{
-  ffetargetHollerithSize i;
-
-  for (i = 0; i < constant.length; ++i)
-    if (constant.text[i] != 0)
-      return FALSE;
-  return TRUE;
-}
-
-/* ffetarget_layout -- Do storage requirement analysis for entity
-
-   Return the alignment/modulo requirements along with the size, given the
-   data type info and the number of elements an array (1 for a scalar).	 */
-
-void
-ffetarget_layout (const char *error_text UNUSED, ffetargetAlign *alignment,
-		  ffetargetAlign *modulo, ffetargetOffset *size,
-		  ffeinfoBasictype bt, ffeinfoKindtype kt,
-		  ffetargetCharacterSize charsize,
-		  ffetargetIntegerDefault num_elements)
-{
-  bool ok;			/* For character type. */
-  ffetargetOffset numele;	/* Converted from num_elements. */
-  ffetype type;
-
-  type = ffeinfo_type (bt, kt);
-  assert (type != NULL);
-
-  *alignment = ffetype_alignment (type);
-  *modulo = ffetype_modulo (type);
-  if (bt == FFEINFO_basictypeCHARACTER)
-    {
-      ok = ffetarget_offset_charsize (size, charsize, ffetype_size (type));
-#ifdef ffetarget_offset_overflow
-      if (!ok)
-	ffetarget_offset_overflow (error_text);
-#endif
-    }
-  else
-    *size = ffetype_size (type);
-
-  if ((num_elements < 0)
-      || !ffetarget_offset (&numele, num_elements)
-      || !ffetarget_offset_multiply (size, *size, numele))
-    {
-      ffetarget_offset_overflow (error_text);
-      *alignment = 1;
-      *modulo = 0;
-      *size = 0;
-    }
-}
-
-/* ffetarget_ne_character1 -- Perform relational comparison on char constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l,
-			 ffetargetCharacter1 r)
-{
-  assert (l.length == r.length);
-  *res = (memcmp (l.text, r.text, l.length) != 0);
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_substr_character1 -- Perform SUBSTR op on three constants
-
-   Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_substr_character1 (ffetargetCharacter1 *res,
-			     ffetargetCharacter1 l,
-			     ffetargetCharacterSize first,
-			     ffetargetCharacterSize last, mallocPool pool,
-			     ffetargetCharacterSize *len)
-{
-  if (last < first)
-    {
-      res->length = *len = 0;
-      res->text = NULL;
-    }
-  else
-    {
-      res->length = *len = last - first + 1;
-      res->text = malloc_new_kp (pool, "ffetargetCharacter1(SUBSTR)", *len + 1);
-      memcpy (res->text, l.text + first - 1, *len);
-      res->text[*len] = '\0';
-    }
-
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_cmp_hollerith -- Produce orderable comparison between two
-   constants
-
-   Compare lengths, if equal then use memcmp.  */
-
-int
-ffetarget_cmp_hollerith (ffetargetHollerith l, ffetargetHollerith r)
-{
-  if (l.length < r.length)
-    return -1;
-  if (l.length > r.length)
-    return 1;
-  return memcmp (l.text, r.text, l.length);
-}
-
-ffebad
-ffetarget_convert_any_character1_ (char *res, size_t size,
-				   ffetargetCharacter1 l)
-{
-  if (size <= (size_t) l.length)
-    {
-      char *p;
-      ffetargetCharacterSize i;
-
-      memcpy (res, l.text, size);
-      for (p = &l.text[0] + size, i = l.length - size;
-	   i > 0;
-	   ++p, --i)
-	if (*p != ' ')
-	  return FFEBAD_TRUNCATING_CHARACTER;
-    }
-  else
-    {
-      memcpy (res, l.text, size);
-      memset (res + l.length, ' ', size - l.length);
-    }
-
-  return FFEBAD;
-}
-
-ffebad
-ffetarget_convert_any_hollerith_ (char *res, size_t size,
-				  ffetargetHollerith l)
-{
-  if (size <= (size_t) l.length)
-    {
-      char *p;
-      ffetargetCharacterSize i;
-
-      memcpy (res, l.text, size);
-      for (p = &l.text[0] + size, i = l.length - size;
-	   i > 0;
-	   ++p, --i)
-	if (*p != ' ')
-	  return FFEBAD_TRUNCATING_HOLLERITH;
-    }
-  else
-    {
-      memcpy (res, l.text, size);
-      memset (res + l.length, ' ', size - l.length);
-    }
-
-  return FFEBAD;
-}
-
-ffebad
-ffetarget_convert_any_typeless_ (char *res, size_t size,
-				 ffetargetTypeless l)
-{
-  unsigned long long int l1;
-  unsigned long int l2;
-  unsigned int l3;
-  unsigned short int l4;
-  unsigned char l5;
-  size_t size_of;
-  char *p;
-
-  if (size >= sizeof (l1))
-    {
-      l1 = l;
-      p = (char *) &l1;
-      size_of = sizeof (l1);
-    }
-  else if (size >= sizeof (l2))
-    {
-      l2 = l;
-      p = (char *) &l2;
-      size_of = sizeof (l2);
-      l1 = l2;
-    }
-  else if (size >= sizeof (l3))
-    {
-      l3 = l;
-      p = (char *) &l3;
-      size_of = sizeof (l3);
-      l1 = l3;
-    }
-  else if (size >= sizeof (l4))
-    {
-      l4 = l;
-      p = (char *) &l4;
-      size_of = sizeof (l4);
-      l1 = l4;
-    }
-  else if (size >= sizeof (l5))
-    {
-      l5 = l;
-      p = (char *) &l5;
-      size_of = sizeof (l5);
-      l1 = l5;
-    }
-  else
-    {
-      assert ("stumped by conversion from typeless!" == NULL);
-      abort ();
-    }
-
-  if (size <= size_of)
-    {
-      int i = size_of - size;
-
-      memcpy (res, p + i, size);
-      for (; i > 0; ++p, --i)
-	if (*p != '\0')
-	  return FFEBAD_TRUNCATING_TYPELESS;
-    }
-  else
-    {
-      int i = size - size_of;
-
-      memset (res, 0, i);
-      memcpy (res + i, p, size_of);
-    }
-
-  if (l1 != l)
-    return FFEBAD_TRUNCATING_TYPELESS;
-  return FFEBAD;
-}
-
-/* Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
-					 ffetargetCharacterSize size,
-					 ffetargetCharacter1 l,
-					 mallocPool pool)
-{
-  res->length = size;
-  if (size == 0)
-    res->text = NULL;
-  else
-    {
-      res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
-      if (size <= l.length)
-	memcpy (res->text, l.text, size);
-      else
-	{
-	  memcpy (res->text, l.text, l.length);
-	  memset (res->text + l.length, ' ', size - l.length);
-	}
-      res->text[size] = '\0';
-    }
-
-  return FFEBAD;
-}
-
-#endif
-
-/* Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
-					ffetargetCharacterSize size,
-					ffetargetHollerith l, mallocPool pool)
-{
-  res->length = size;
-  if (size == 0)
-    res->text = NULL;
-  else
-    {
-      res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
-      res->text[size] = '\0';
-      if (size <= l.length)
-	{
-	  char *p;
-	  ffetargetCharacterSize i;
-
-	  memcpy (res->text, l.text, size);
-	  for (p = &l.text[0] + size, i = l.length - size;
-	       i > 0;
-	       ++p, --i)
-	    if (*p != ' ')
-	      return FFEBAD_TRUNCATING_HOLLERITH;
-	}
-      else
-	{
-	  memcpy (res->text, l.text, l.length);
-	  memset (res->text + l.length, ' ', size - l.length);
-	}
-    }
-
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_convert_character1_integer4 -- Raw conversion.
-
-   Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
-				       ffetargetCharacterSize size,
-				       ffetargetInteger4 l, mallocPool pool)
-{
-  long long int l1;
-  long int l2;
-  int l3;
-  short int l4;
-  char l5;
-  size_t size_of;
-  char *p;
-
-  if (((size_t) size) >= sizeof (l1))
-    {
-      l1 = l;
-      p = (char *) &l1;
-      size_of = sizeof (l1);
-    }
-  else if (((size_t) size) >= sizeof (l2))
-    {
-      l2 = l;
-      p = (char *) &l2;
-      size_of = sizeof (l2);
-      l1 = l2;
-    }
-  else if (((size_t) size) >= sizeof (l3))
-    {
-      l3 = l;
-      p = (char *) &l3;
-      size_of = sizeof (l3);
-      l1 = l3;
-    }
-  else if (((size_t) size) >= sizeof (l4))
-    {
-      l4 = l;
-      p = (char *) &l4;
-      size_of = sizeof (l4);
-      l1 = l4;
-    }
-  else if (((size_t) size) >= sizeof (l5))
-    {
-      l5 = l;
-      p = (char *) &l5;
-      size_of = sizeof (l5);
-      l1 = l5;
-    }
-  else
-    {
-      assert ("stumped by conversion from integer1!" == NULL);
-      abort ();
-    }
-
-  res->length = size;
-  if (size == 0)
-    res->text = NULL;
-  else
-    {
-      res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
-      res->text[size] = '\0';
-      if (((size_t) size) <= size_of)
-	{
-	  int i = size_of - size;
-
-	  memcpy (res->text, p + i, size);
-	  for (; i > 0; ++p, --i)
-	    if (*p != 0)
-	      return FFEBAD_TRUNCATING_NUMERIC;
-	}
-      else
-	{
-	  int i = size - size_of;
-
-	  memset (res->text, 0, i);
-	  memcpy (res->text + i, p, size_of);
-	}
-    }
-
-  if (l1 != l)
-    return FFEBAD_TRUNCATING_NUMERIC;
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_convert_character1_logical4 -- Raw conversion.
-
-   Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
-				       ffetargetCharacterSize size,
-				       ffetargetLogical4 l, mallocPool pool)
-{
-  long long int l1;
-  long int l2;
-  int l3;
-  short int l4;
-  char l5;
-  size_t size_of;
-  char *p;
-
-  if (((size_t) size) >= sizeof (l1))
-    {
-      l1 = l;
-      p = (char *) &l1;
-      size_of = sizeof (l1);
-    }
-  else if (((size_t) size) >= sizeof (l2))
-    {
-      l2 = l;
-      p = (char *) &l2;
-      size_of = sizeof (l2);
-      l1 = l2;
-    }
-  else if (((size_t) size) >= sizeof (l3))
-    {
-      l3 = l;
-      p = (char *) &l3;
-      size_of = sizeof (l3);
-      l1 = l3;
-    }
-  else if (((size_t) size) >= sizeof (l4))
-    {
-      l4 = l;
-      p = (char *) &l4;
-      size_of = sizeof (l4);
-      l1 = l4;
-    }
-  else if (((size_t) size) >= sizeof (l5))
-    {
-      l5 = l;
-      p = (char *) &l5;
-      size_of = sizeof (l5);
-      l1 = l5;
-    }
-  else
-    {
-      assert ("stumped by conversion from logical1!" == NULL);
-      abort ();
-    }
-
-  res->length = size;
-  if (size == 0)
-    res->text = NULL;
-  else
-    {
-      res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
-      res->text[size] = '\0';
-      if (((size_t) size) <= size_of)
-	{
-	  int i = size_of - size;
-
-	  memcpy (res->text, p + i, size);
-	  for (; i > 0; ++p, --i)
-	    if (*p != 0)
-	      return FFEBAD_TRUNCATING_NUMERIC;
-	}
-      else
-	{
-	  int i = size - size_of;
-
-	  memset (res->text, 0, i);
-	  memcpy (res->text + i, p, size_of);
-	}
-    }
-
-  if (l1 != l)
-    return FFEBAD_TRUNCATING_NUMERIC;
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_convert_character1_typeless -- Raw conversion.
-
-   Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-#if FFETARGET_okCHARACTER1
-ffebad
-ffetarget_convert_character1_typeless (ffetargetCharacter1 *res,
-				       ffetargetCharacterSize size,
-				       ffetargetTypeless l, mallocPool pool)
-{
-  unsigned long long int l1;
-  unsigned long int l2;
-  unsigned int l3;
-  unsigned short int l4;
-  unsigned char l5;
-  size_t size_of;
-  char *p;
-
-  if (((size_t) size) >= sizeof (l1))
-    {
-      l1 = l;
-      p = (char *) &l1;
-      size_of = sizeof (l1);
-    }
-  else if (((size_t) size) >= sizeof (l2))
-    {
-      l2 = l;
-      p = (char *) &l2;
-      size_of = sizeof (l2);
-      l1 = l2;
-    }
-  else if (((size_t) size) >= sizeof (l3))
-    {
-      l3 = l;
-      p = (char *) &l3;
-      size_of = sizeof (l3);
-      l1 = l3;
-    }
-  else if (((size_t) size) >= sizeof (l4))
-    {
-      l4 = l;
-      p = (char *) &l4;
-      size_of = sizeof (l4);
-      l1 = l4;
-    }
-  else if (((size_t) size) >= sizeof (l5))
-    {
-      l5 = l;
-      p = (char *) &l5;
-      size_of = sizeof (l5);
-      l1 = l5;
-    }
-  else
-    {
-      assert ("stumped by conversion from typeless!" == NULL);
-      abort ();
-    }
-
-  res->length = size;
-  if (size == 0)
-    res->text = NULL;
-  else
-    {
-      res->text = malloc_new_kp (pool, "FFETARGET cvt char1", size + 1);
-      res->text[size] = '\0';
-      if (((size_t) size) <= size_of)
-	{
-	  int i = size_of - size;
-
-	  memcpy (res->text, p + i, size);
-	  for (; i > 0; ++p, --i)
-	    if (*p != 0)
-	      return FFEBAD_TRUNCATING_TYPELESS;
-	}
-      else
-	{
-	  int i = size - size_of;
-
-	  memset (res->text, 0, i);
-	  memcpy (res->text + i, p, size_of);
-	}
-    }
-
-  if (l1 != l)
-    return FFEBAD_TRUNCATING_TYPELESS;
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_divide_complex1 -- Divide function
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX1
-ffebad
-ffetarget_divide_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
-			   ffetargetComplex1 r)
-{
-  ffebad bad;
-  ffetargetReal1 tmp1, tmp2, tmp3, tmp4;
-
-  bad = ffetarget_multiply_real1 (&tmp1, r.real, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real1 (&tmp2, r.imaginary, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_add_real1 (&tmp3, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-
-  if (ffetarget_iszero_real1 (tmp3))
-    {
-      ffetarget_real1_zero (&(res)->real);
-      ffetarget_real1_zero (&(res)->imaginary);
-      return FFEBAD_DIV_BY_ZERO;
-    }
-
-  bad = ffetarget_multiply_real1 (&tmp1, l.real, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_add_real1 (&tmp4, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_divide_real1 (&res->real, tmp4, tmp3);
-  if (bad != FFEBAD)
-    return bad;
-
-  bad = ffetarget_multiply_real1 (&tmp1, r.real, l.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real1 (&tmp2, l.real, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_subtract_real1 (&tmp4, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_divide_real1 (&res->imaginary, tmp4, tmp3);
-
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_divide_complex2 -- Divide function
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX2
-ffebad
-ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
-			   ffetargetComplex2 r)
-{
-  ffebad bad;
-  ffetargetReal2 tmp1, tmp2, tmp3, tmp4;
-
-  bad = ffetarget_multiply_real2 (&tmp1, r.real, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real2 (&tmp2, r.imaginary, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_add_real2 (&tmp3, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-
-  if (ffetarget_iszero_real2 (tmp3))
-    {
-      ffetarget_real2_zero (&(res)->real);
-      ffetarget_real2_zero (&(res)->imaginary);
-      return FFEBAD_DIV_BY_ZERO;
-    }
-
-  bad = ffetarget_multiply_real2 (&tmp1, l.real, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_add_real2 (&tmp4, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_divide_real2 (&res->real, tmp4, tmp3);
-  if (bad != FFEBAD)
-    return bad;
-
-  bad = ffetarget_multiply_real2 (&tmp1, r.real, l.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real2 (&tmp2, l.real, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_subtract_real2 (&tmp4, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_divide_real2 (&res->imaginary, tmp4, tmp3);
-
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_hollerith -- Convert token to a hollerith constant
-
-   Always append a null byte to the end, in case this is wanted in
-   a special case such as passing a string as a FORMAT or %REF.
-   Done to save a bit of hassle, nothing more, but it's a kludge anyway,
-   because it isn't a "feature" that is self-documenting.  Use the
-   string "FFETARGET-NULL-KLUDGE" to flag anyplace you use this feature
-   in the code.  */
-
-bool
-ffetarget_hollerith (ffetargetHollerith *val, ffelexToken integer,
-		     mallocPool pool)
-{
-  val->length = ffelex_token_length (integer);
-  val->text = malloc_new_kp (pool, "ffetargetHollerith", val->length + 1);
-  memcpy (val->text, ffelex_token_text (integer), val->length);
-  val->text[val->length] = '\0';
-
-  return TRUE;
-}
-
-/* ffetarget_integer_bad_magical -- Complain about a magical number
-
-   Just calls ffebad with the arguments.  */
-
-void
-ffetarget_integer_bad_magical (ffelexToken t)
-{
-  ffebad_start (FFEBAD_BAD_MAGICAL);
-  ffebad_here (0, ffelex_token_where_line (t), ffelex_token_where_column (t));
-  ffebad_finish ();
-}
-
-/* ffetarget_integer_bad_magical_binary -- Complain about a magical number
-
-   Just calls ffebad with the arguments.  */
-
-void
-ffetarget_integer_bad_magical_binary (ffelexToken integer,
-				      ffelexToken minus)
-{
-  ffebad_start (FFEBAD_BAD_MAGICAL_BINARY);
-  ffebad_here (0, ffelex_token_where_line (integer),
-	       ffelex_token_where_column (integer));
-  ffebad_here (1, ffelex_token_where_line (minus),
-	       ffelex_token_where_column (minus));
-  ffebad_finish ();
-}
-
-/* ffetarget_integer_bad_magical_precedence -- Complain about a magical
-						   number
-
-   Just calls ffebad with the arguments.  */
-
-void
-ffetarget_integer_bad_magical_precedence (ffelexToken integer,
-					  ffelexToken uminus,
-					  ffelexToken higher_op)
-{
-  ffebad_start (FFEBAD_BAD_MAGICAL_PRECEDENCE);
-  ffebad_here (0, ffelex_token_where_line (integer),
-	       ffelex_token_where_column (integer));
-  ffebad_here (1, ffelex_token_where_line (uminus),
-	       ffelex_token_where_column (uminus));
-  ffebad_here (2, ffelex_token_where_line (higher_op),
-	       ffelex_token_where_column (higher_op));
-  ffebad_finish ();
-}
-
-/* ffetarget_integer_bad_magical_precedence_binary -- Complain...
-
-   Just calls ffebad with the arguments.  */
-
-void
-ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer,
-						 ffelexToken minus,
-						 ffelexToken higher_op)
-{
-  ffebad_start (FFEBAD_BAD_MAGICAL_PRECEDENCE_BINARY);
-  ffebad_here (0, ffelex_token_where_line (integer),
-	       ffelex_token_where_column (integer));
-  ffebad_here (1, ffelex_token_where_line (minus),
-	       ffelex_token_where_column (minus));
-  ffebad_here (2, ffelex_token_where_line (higher_op),
-	       ffelex_token_where_column (higher_op));
-  ffebad_finish ();
-}
-
-/* ffetarget_integer1 -- Convert token to an integer
-
-   See prototype.
-
-   Token use count not affected overall.  */
-
-#if FFETARGET_okINTEGER1
-bool
-ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer)
-{
-  ffetargetInteger1 x;
-  char *p;
-  char c;
-
-  assert (ffelex_token_type (integer) == FFELEX_typeNUMBER);
-
-  p = ffelex_token_text (integer);
-  x = 0;
-
-  /* Skip past leading zeros. */
-
-  while (((c = *p) != '\0') && (c == '0'))
-    ++p;
-
-  /* Interpret rest of number. */
-
-  while (c != '\0')
-    {
-      if ((x == FFETARGET_integerALMOST_BIG_MAGICAL)
-	  && (c == '0' + FFETARGET_integerFINISH_BIG_MAGICAL)
-	  && (*(p + 1) == '\0'))
-	{
-	  *val = (ffetargetInteger1) FFETARGET_integerBIG_MAGICAL;
-	  return TRUE;
-	}
-      else if (x == FFETARGET_integerALMOST_BIG_MAGICAL)
-	{
-	  if ((c > '0' + FFETARGET_integerFINISH_BIG_MAGICAL)
-	      || (*(p + 1) != '\0'))
-	    {
-	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	      ffebad_here (0, ffelex_token_where_line (integer),
-			   ffelex_token_where_column (integer));
-	      ffebad_finish ();
-	      *val = 0;
-	      return FALSE;
-	    }
-	}
-      else if (x > FFETARGET_integerALMOST_BIG_MAGICAL)
-	{
-	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	  ffebad_here (0, ffelex_token_where_line (integer),
-		       ffelex_token_where_column (integer));
-	  ffebad_finish ();
-	  *val = 0;
-	  return FALSE;
-	}
-      x = x * 10 + c - '0';
-      c = *(++p);
-    };
-
-  *val = x;
-  return TRUE;
-}
-
-#endif
-/* ffetarget_integerbinary -- Convert token to a binary integer
-
-   ffetarget_integerbinary x;
-   if (ffetarget_integerdefault_8(&x,integer_token))
-       // conversion ok.
-
-   Token use count not affected overall.  */
-
-bool
-ffetarget_integerbinary (ffetargetIntegerDefault *val, ffelexToken integer)
-{
-  ffetargetIntegerDefault x;
-  char *p;
-  char c;
-  bool bad_digit;
-
-  assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
-	  || (ffelex_token_type (integer) == FFELEX_typeNUMBER));
-
-  p = ffelex_token_text (integer);
-  x = 0;
-
-  /* Skip past leading zeros. */
-
-  while (((c = *p) != '\0') && (c == '0'))
-    ++p;
-
-  /* Interpret rest of number. */
-
-  bad_digit = FALSE;
-  while (c != '\0')
-    {
-      if ((c >= '0') && (c <= '1'))
-	c -= '0';
-      else
-	{
-	  bad_digit = TRUE;
-	  c = 0;
-	}
-
-#if 0				/* Don't complain about signed overflow; just
-				   unsigned overflow. */
-      if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
-	  && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY)
-	  && (*(p + 1) == '\0'))
-	{
-	  *val = FFETARGET_integerBIG_OVERFLOW_BINARY;
-	  return TRUE;
-	}
-      else
-#endif
-#if FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY == 0
-      if ((x & FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY) != 0)
-#else
-      if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
-	{
-	  if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY)
-	      || (*(p + 1) != '\0'))
-	    {
-	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	      ffebad_here (0, ffelex_token_where_line (integer),
-			   ffelex_token_where_column (integer));
-	      ffebad_finish ();
-	      *val = 0;
-	      return FALSE;
-	    }
-	}
-      else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY)
-#endif
-	{
-	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	  ffebad_here (0, ffelex_token_where_line (integer),
-		       ffelex_token_where_column (integer));
-	  ffebad_finish ();
-	  *val = 0;
-	  return FALSE;
-	}
-      x = (x << 1) + c;
-      c = *(++p);
-    };
-
-  if (bad_digit)
-    {
-      ffebad_start (FFEBAD_INVALID_BINARY_DIGIT);
-      ffebad_here (0, ffelex_token_where_line (integer),
-		   ffelex_token_where_column (integer));
-      ffebad_finish ();
-    }
-
-  *val = x;
-  return !bad_digit;
-}
-
-/* ffetarget_integerhex -- Convert token to a hex integer
-
-   ffetarget_integerhex x;
-   if (ffetarget_integerdefault_8(&x,integer_token))
-       // conversion ok.
-
-   Token use count not affected overall.  */
-
-bool
-ffetarget_integerhex (ffetargetIntegerDefault *val, ffelexToken integer)
-{
-  ffetargetIntegerDefault x;
-  char *p;
-  char c;
-  bool bad_digit;
-
-  assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
-	  || (ffelex_token_type (integer) == FFELEX_typeNUMBER));
-
-  p = ffelex_token_text (integer);
-  x = 0;
-
-  /* Skip past leading zeros. */
-
-  while (((c = *p) != '\0') && (c == '0'))
-    ++p;
-
-  /* Interpret rest of number. */
-
-  bad_digit = FALSE;
-  while (c != '\0')
-    {
-      if (hex_p (c))
-	c = hex_value (c);
-      else
-	{
-	  bad_digit = TRUE;
-	  c = 0;
-	}
-
-#if 0				/* Don't complain about signed overflow; just
-				   unsigned overflow. */
-      if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
-	  && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_HEX)
-	  && (*(p + 1) == '\0'))
-	{
-	  *val = FFETARGET_integerBIG_OVERFLOW_HEX;
-	  return TRUE;
-	}
-      else
-#endif
-#if FFETARGET_integerFINISH_BIG_OVERFLOW_HEX == 0
-      if (x >= FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
-#else
-      if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
-	{
-	  if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_HEX)
-	      || (*(p + 1) != '\0'))
-	    {
-	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	      ffebad_here (0, ffelex_token_where_line (integer),
-			   ffelex_token_where_column (integer));
-	      ffebad_finish ();
-	      *val = 0;
-	      return FALSE;
-	    }
-	}
-      else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_HEX)
-#endif
-	{
-	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	  ffebad_here (0, ffelex_token_where_line (integer),
-		       ffelex_token_where_column (integer));
-	  ffebad_finish ();
-	  *val = 0;
-	  return FALSE;
-	}
-      x = (x << 4) + c;
-      c = *(++p);
-    };
-
-  if (bad_digit)
-    {
-      ffebad_start (FFEBAD_INVALID_HEX_DIGIT);
-      ffebad_here (0, ffelex_token_where_line (integer),
-		   ffelex_token_where_column (integer));
-      ffebad_finish ();
-    }
-
-  *val = x;
-  return !bad_digit;
-}
-
-/* ffetarget_integeroctal -- Convert token to an octal integer
-
-   ffetarget_integeroctal x;
-   if (ffetarget_integerdefault_8(&x,integer_token))
-       // conversion ok.
-
-   Token use count not affected overall.  */
-
-bool
-ffetarget_integeroctal (ffetargetIntegerDefault *val, ffelexToken integer)
-{
-  ffetargetIntegerDefault x;
-  char *p;
-  char c;
-  bool bad_digit;
-
-  assert ((ffelex_token_type (integer) == FFELEX_typeNAME)
-	  || (ffelex_token_type (integer) == FFELEX_typeNUMBER));
-
-  p = ffelex_token_text (integer);
-  x = 0;
-
-  /* Skip past leading zeros. */
-
-  while (((c = *p) != '\0') && (c == '0'))
-    ++p;
-
-  /* Interpret rest of number. */
-
-  bad_digit = FALSE;
-  while (c != '\0')
-    {
-      if ((c >= '0') && (c <= '7'))
-	c -= '0';
-      else
-	{
-	  bad_digit = TRUE;
-	  c = 0;
-	}
-
-#if 0				/* Don't complain about signed overflow; just
-				   unsigned overflow. */
-      if ((x == FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
-	  && (c == FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL)
-	  && (*(p + 1) == '\0'))
-	{
-	  *val = FFETARGET_integerBIG_OVERFLOW_OCTAL;
-	  return TRUE;
-	}
-      else
-#endif
-#if FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL == 0
-      if (x >= FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
-#else
-      if (x == FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
-	{
-	  if ((c > FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL)
-	      || (*(p + 1) != '\0'))
-	    {
-	      ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	      ffebad_here (0, ffelex_token_where_line (integer),
-			   ffelex_token_where_column (integer));
-	      ffebad_finish ();
-	      *val = 0;
-	      return FALSE;
-	    }
-	}
-      else if (x > FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL)
-#endif
-	{
-	  ffebad_start (FFEBAD_INTEGER_TOO_LARGE);
-	  ffebad_here (0, ffelex_token_where_line (integer),
-		       ffelex_token_where_column (integer));
-	  ffebad_finish ();
-	  *val = 0;
-	  return FALSE;
-	}
-      x = (x << 3) + c;
-      c = *(++p);
-    };
-
-  if (bad_digit)
-    {
-      ffebad_start (FFEBAD_INVALID_OCTAL_DIGIT);
-      ffebad_here (0, ffelex_token_where_line (integer),
-		   ffelex_token_where_column (integer));
-      ffebad_finish ();
-    }
-
-  *val = x;
-  return !bad_digit;
-}
-
-/* ffetarget_multiply_complex1 -- Multiply function
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX1
-ffebad
-ffetarget_multiply_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
-			     ffetargetComplex1 r)
-{
-  ffebad bad;
-  ffetargetReal1 tmp1, tmp2;
-
-  bad = ffetarget_multiply_real1 (&tmp1, l.real, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_subtract_real1 (&res->real, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real1 (&tmp1, l.imaginary, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real1 (&tmp2, l.real, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_add_real1 (&res->imaginary, tmp1, tmp2);
-
-  return bad;
-}
-
-#endif
-/* ffetarget_multiply_complex2 -- Multiply function
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEX2
-ffebad
-ffetarget_multiply_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
-			     ffetargetComplex2 r)
-{
-  ffebad bad;
-  ffetargetReal2 tmp1, tmp2;
-
-  bad = ffetarget_multiply_real2 (&tmp1, l.real, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_subtract_real2 (&res->real, tmp1, tmp2);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real2 (&tmp1, l.imaginary, r.real);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_multiply_real2 (&tmp2, l.real, r.imaginary);
-  if (bad != FFEBAD)
-    return bad;
-  bad = ffetarget_add_real2 (&res->imaginary, tmp1, tmp2);
-
-  return bad;
-}
-
-#endif
-/* ffetarget_power_complexdefault_integerdefault -- Power function
-
-   See prototype.  */
-
-ffebad
-ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res,
-					       ffetargetComplexDefault l,
-					       ffetargetIntegerDefault r)
-{
-  ffebad bad;
-  ffetargetRealDefault tmp;
-  ffetargetRealDefault tmp1;
-  ffetargetRealDefault tmp2;
-  ffetargetRealDefault two;
-
-  if (ffetarget_iszero_real1 (l.real)
-      && ffetarget_iszero_real1 (l.imaginary))
-    {
-      ffetarget_real1_zero (&res->real);
-      ffetarget_real1_zero (&res->imaginary);
-      return FFEBAD;
-    }
-
-  if (r == 0)
-    {
-      ffetarget_real1_one (&res->real);
-      ffetarget_real1_zero (&res->imaginary);
-      return FFEBAD;
-    }
-
-  if (r < 0)
-    {
-      r = -r;
-      bad = ffetarget_multiply_real1 (&tmp1, l.real, l.real);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_add_real1 (&tmp, tmp1, tmp2);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_divide_real1 (&l.real, l.real, tmp);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_divide_real1 (&l.imaginary, l.imaginary, tmp);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_uminus_real1 (&l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-    }
-
-  ffetarget_real1_two (&two);
-
-  while ((r & 1) == 0)
-    {
-      bad = ffetarget_multiply_real1 (&tmp1, l.real, l.real);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_subtract_real1 (&tmp, tmp1, tmp2);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&l.imaginary, l.real, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&l.imaginary, l.imaginary, two);
-      if (bad != FFEBAD)
-	return bad;
-      l.real = tmp;
-      r >>= 1;
-    }
-
-  *res = l;
-  r >>= 1;
-
-  while (r != 0)
-    {
-      bad = ffetarget_multiply_real1 (&tmp1, l.real, l.real);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&tmp2, l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_subtract_real1 (&tmp, tmp1, tmp2);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&l.imaginary, l.real, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real1 (&l.imaginary, l.imaginary, two);
-      if (bad != FFEBAD)
-	return bad;
-      l.real = tmp;
-      if ((r & 1) == 1)
-	{
-	  bad = ffetarget_multiply_real1 (&tmp1, res->real, l.real);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_multiply_real1 (&tmp2, res->imaginary,
-					  l.imaginary);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_subtract_real1 (&tmp, tmp1, tmp2);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_multiply_real1 (&tmp1, res->imaginary, l.real);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_multiply_real1 (&tmp2, res->real, l.imaginary);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_add_real1 (&res->imaginary, tmp1, tmp2);
-	  if (bad != FFEBAD)
-	    return bad;
-	  res->real = tmp;
-	}
-      r >>= 1;
-    }
-
-  return FFEBAD;
-}
-
-/* ffetarget_power_complexdouble_integerdefault -- Power function
-
-   See prototype.  */
-
-#if FFETARGET_okCOMPLEXDOUBLE
-ffebad
-ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble *res,
-			ffetargetComplexDouble l, ffetargetIntegerDefault r)
-{
-  ffebad bad;
-  ffetargetRealDouble tmp;
-  ffetargetRealDouble tmp1;
-  ffetargetRealDouble tmp2;
-  ffetargetRealDouble two;
-
-  if (ffetarget_iszero_real2 (l.real)
-      && ffetarget_iszero_real2 (l.imaginary))
-    {
-      ffetarget_real2_zero (&res->real);
-      ffetarget_real2_zero (&res->imaginary);
-      return FFEBAD;
-    }
-
-  if (r == 0)
-    {
-      ffetarget_real2_one (&res->real);
-      ffetarget_real2_zero (&res->imaginary);
-      return FFEBAD;
-    }
-
-  if (r < 0)
-    {
-      r = -r;
-      bad = ffetarget_multiply_real2 (&tmp1, l.real, l.real);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_add_real2 (&tmp, tmp1, tmp2);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_divide_real2 (&l.real, l.real, tmp);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_divide_real2 (&l.imaginary, l.imaginary, tmp);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_uminus_real2 (&l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-    }
-
-  ffetarget_real2_two (&two);
-
-  while ((r & 1) == 0)
-    {
-      bad = ffetarget_multiply_real2 (&tmp1, l.real, l.real);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_subtract_real2 (&tmp, tmp1, tmp2);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&l.imaginary, l.real, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&l.imaginary, l.imaginary, two);
-      if (bad != FFEBAD)
-	return bad;
-      l.real = tmp;
-      r >>= 1;
-    }
-
-  *res = l;
-  r >>= 1;
-
-  while (r != 0)
-    {
-      bad = ffetarget_multiply_real2 (&tmp1, l.real, l.real);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&tmp2, l.imaginary, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_subtract_real2 (&tmp, tmp1, tmp2);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&l.imaginary, l.real, l.imaginary);
-      if (bad != FFEBAD)
-	return bad;
-      bad = ffetarget_multiply_real2 (&l.imaginary, l.imaginary, two);
-      if (bad != FFEBAD)
-	return bad;
-      l.real = tmp;
-      if ((r & 1) == 1)
-	{
-	  bad = ffetarget_multiply_real2 (&tmp1, res->real, l.real);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_multiply_real2 (&tmp2, res->imaginary,
-					  l.imaginary);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_subtract_real2 (&tmp, tmp1, tmp2);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_multiply_real2 (&tmp1, res->imaginary, l.real);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_multiply_real2 (&tmp2, res->real, l.imaginary);
-	  if (bad != FFEBAD)
-	    return bad;
-	  bad = ffetarget_add_real2 (&res->imaginary, tmp1, tmp2);
-	  if (bad != FFEBAD)
-	    return bad;
-	  res->real = tmp;
-	}
-      r >>= 1;
-    }
-
-  return FFEBAD;
-}
-
-#endif
-/* ffetarget_power_integerdefault_integerdefault -- Power function
-
-   See prototype.  */
-
-ffebad
-ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault *res,
-		       ffetargetIntegerDefault l, ffetargetIntegerDefault r)
-{
-  if (l == 0)
-    {
-      *res = 0;
-      return FFEBAD;
-    }
-
-  if (r == 0)
-    {
-      *res = 1;
-      return FFEBAD;
-    }
-
-  if (r < 0)
-    {
-      if (l == 1)
-	*res = 1;
-      else if (l == 0)
-	*res = 1;
-      else if (l == -1)
-	*res = ((-r) & 1) == 0 ? 1 : -1;
-      else
-	*res = 0;
-      return FFEBAD;
-    }
-
-  while ((r & 1) == 0)
-    {
-      l *= l;
-      r >>= 1;
-    }
-
-  *res = l;
-  r >>= 1;
-
-  while (r != 0)
-    {
-      l *= l;
-      if ((r & 1) == 1)
-	*res *= l;
-      r >>= 1;
-    }
-
-  return FFEBAD;
-}
-
-/* ffetarget_power_realdefault_integerdefault -- Power function
-
-   See prototype.  */
-
-ffebad
-ffetarget_power_realdefault_integerdefault (ffetargetRealDefault *res,
-			  ffetargetRealDefault l, ffetargetIntegerDefault r)
-{
-  ffebad bad;
-
-  if (ffetarget_iszero_real1 (l))
-    {
-      ffetarget_real1_zero (res);
-      return FFEBAD;
-    }
-
-  if (r == 0)
-    {
-      ffetarget_real1_one (res);
-      return FFEBAD;
-    }
-
-  if (r < 0)
-    {
-      ffetargetRealDefault one;
-
-      ffetarget_real1_one (&one);
-      r = -r;
-      bad = ffetarget_divide_real1 (&l, one, l);
-      if (bad != FFEBAD)
-	return bad;
-    }
-
-  while ((r & 1) == 0)
-    {
-      bad = ffetarget_multiply_real1 (&l, l, l);
-      if (bad != FFEBAD)
-	return bad;
-      r >>= 1;
-    }
-
-  *res = l;
-  r >>= 1;
-
-  while (r != 0)
-    {
-      bad = ffetarget_multiply_real1 (&l, l, l);
-      if (bad != FFEBAD)
-	return bad;
-      if ((r & 1) == 1)
-	{
-	  bad = ffetarget_multiply_real1 (res, *res, l);
-	  if (bad != FFEBAD)
-	    return bad;
-	}
-      r >>= 1;
-    }
-
-  return FFEBAD;
-}
-
-/* ffetarget_power_realdouble_integerdefault -- Power function
-
-   See prototype.  */
-
-ffebad
-ffetarget_power_realdouble_integerdefault (ffetargetRealDouble *res,
-					   ffetargetRealDouble l,
-					   ffetargetIntegerDefault r)
-{
-  ffebad bad;
-
-  if (ffetarget_iszero_real2 (l))
-    {
-      ffetarget_real2_zero (res);
-      return FFEBAD;
-    }
-
-  if (r == 0)
-    {
-      ffetarget_real2_one (res);
-      return FFEBAD;
-    }
-
-  if (r < 0)
-    {
-      ffetargetRealDouble one;
-
-      ffetarget_real2_one (&one);
-      r = -r;
-      bad = ffetarget_divide_real2 (&l, one, l);
-      if (bad != FFEBAD)
-	return bad;
-    }
-
-  while ((r & 1) == 0)
-    {
-      bad = ffetarget_multiply_real2 (&l, l, l);
-      if (bad != FFEBAD)
-	return bad;
-      r >>= 1;
-    }
-
-  *res = l;
-  r >>= 1;
-
-  while (r != 0)
-    {
-      bad = ffetarget_multiply_real2 (&l, l, l);
-      if (bad != FFEBAD)
-	return bad;
-      if ((r & 1) == 1)
-	{
-	  bad = ffetarget_multiply_real2 (res, *res, l);
-	  if (bad != FFEBAD)
-	    return bad;
-	}
-      r >>= 1;
-    }
-
-  return FFEBAD;
-}
-
-/* ffetarget_print_binary -- Output typeless binary integer
-
-   ffetargetTypeless val;
-   ffetarget_typeless_binary(dmpout,val);  */
-
-void
-ffetarget_print_binary (FILE *f, ffetargetTypeless value)
-{
-  char *p;
-  char digits[sizeof (value) * CHAR_BIT + 1];
-
-  if (f == NULL)
-    f = dmpout;
-
-  p = &digits[ARRAY_SIZE (digits) - 1];
-  *p = '\0';
-  do
-    {
-      *--p = (value & 1) + '0';
-      value >>= 1;
-    } while (value == 0);
-
-  fputs (p, f);
-}
-
-/* ffetarget_print_character1 -- Output character string
-
-   ffetargetCharacter1 val;
-   ffetarget_print_character1(dmpout,val);  */
-
-void
-ffetarget_print_character1 (FILE *f, ffetargetCharacter1 value)
-{
-  unsigned char *p;
-  ffetargetCharacterSize i;
-
-  fputc ('\'', dmpout);
-  for (i = 0, p = value.text; i < value.length; ++i, ++p)
-    ffetarget_print_char_ (f, *p);
-  fputc ('\'', dmpout);
-}
-
-/* ffetarget_print_hollerith -- Output hollerith string
-
-   ffetargetHollerith val;
-   ffetarget_print_hollerith(dmpout,val);  */
-
-void
-ffetarget_print_hollerith (FILE *f, ffetargetHollerith value)
-{
-  unsigned char *p;
-  ffetargetHollerithSize i;
-
-  fputc ('\'', dmpout);
-  for (i = 0, p = value.text; i < value.length; ++i, ++p)
-    ffetarget_print_char_ (f, *p);
-  fputc ('\'', dmpout);
-}
-
-/* ffetarget_print_octal -- Output typeless octal integer
-
-   ffetargetTypeless val;
-   ffetarget_print_octal(dmpout,val);  */
-
-void
-ffetarget_print_octal (FILE *f, ffetargetTypeless value)
-{
-  char *p;
-  char digits[sizeof (value) * CHAR_BIT / 3 + 1];
-
-  if (f == NULL)
-    f = dmpout;
-
-  p = &digits[ARRAY_SIZE (digits) - 3];
-  *p = '\0';
-  do
-    {
-      *--p = (value & 3) + '0';
-      value >>= 3;
-    } while (value == 0);
-
-  fputs (p, f);
-}
-
-/* ffetarget_print_hex -- Output typeless hex integer
-
-   ffetargetTypeless val;
-   ffetarget_print_hex(dmpout,val);  */
-
-void
-ffetarget_print_hex (FILE *f, ffetargetTypeless value)
-{
-  char *p;
-  char digits[sizeof (value) * CHAR_BIT / 4 + 1];
-  static const char hexdigits[16] = "0123456789ABCDEF";
-
-  if (f == NULL)
-    f = dmpout;
-
-  p = &digits[ARRAY_SIZE (digits) - 3];
-  *p = '\0';
-  do
-    {
-      *--p = hexdigits[value & 4];
-      value >>= 4;
-    } while (value == 0);
-
-  fputs (p, f);
-}
-
-/* ffetarget_real1 -- Convert token to a single-precision real number
-
-   See prototype.
-
-   Pass NULL for any token not provided by the user, but a valid Fortran
-   real number must be provided somehow.  For example, it is ok for
-   exponent_sign_token and exponent_digits_token to be NULL as long as
-   exponent_token not only starts with "E" or "e" but also contains at least
-   one digit following it.  Token use counts not affected overall.  */
-
-#if FFETARGET_okREAL1
-bool
-ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer,
-		 ffelexToken decimal, ffelexToken fraction,
-		 ffelexToken exponent, ffelexToken exponent_sign,
-		 ffelexToken exponent_digits)
-{
-  size_t sz = 1;		/* Allow room for '\0' byte at end. */
-  char *ptr = &ffetarget_string_[0];
-  char *p = ptr;
-  char *q;
-
-#define dotok(x) if (x != NULL) ++sz;
-#define dotoktxt(x) if (x != NULL) sz += ffelex_token_length(x)
-
-  dotoktxt (integer);
-  dotok (decimal);
-  dotoktxt (fraction);
-  dotoktxt (exponent);
-  dotok (exponent_sign);
-  dotoktxt (exponent_digits);
-
-#undef dotok
-#undef dotoktxt
-
-  if (sz > ARRAY_SIZE (ffetarget_string_))
-    p = ptr = malloc_new_ks (malloc_pool_image (), "ffetarget_real1", sz);
-
-#define dotoktxt(x) if (x != NULL)				   \
-		  {						   \
-		  for (q = ffelex_token_text(x); *q != '\0'; ++q)  \
-		    *p++ = *q;					   \
-		  }
-
-  dotoktxt (integer);
-
-  if (decimal != NULL)
-    *p++ = '.';
-
-  dotoktxt (fraction);
-  dotoktxt (exponent);
-
-  if (exponent_sign != NULL)
-    {
-      if (ffelex_token_type (exponent_sign) == FFELEX_typePLUS)
-	*p++ = '+';
-      else
-	{
-	  assert (ffelex_token_type (exponent_sign) == FFELEX_typeMINUS);
-	  *p++ = '-';
-	}
-    }
-
-  dotoktxt (exponent_digits);
-
-#undef dotoktxt
-
-  *p = '\0';
-
-  {
-    REAL_VALUE_TYPE rv;
-    real_from_string (&rv, ptr);
-    ffetarget_make_real1 (value, rv);
-  }
-
-  if (sz > ARRAY_SIZE (ffetarget_string_))
-    malloc_kill_ks (malloc_pool_image (), ptr, sz);
-
-  return TRUE;
-}
-
-#endif
-/* ffetarget_real2 -- Convert token to a single-precision real number
-
-   See prototype.
-
-   Pass NULL for any token not provided by the user, but a valid Fortran
-   real number must be provided somehow.  For example, it is ok for
-   exponent_sign_token and exponent_digits_token to be NULL as long as
-   exponent_token not only starts with "E" or "e" but also contains at least
-   one digit following it.  Token use counts not affected overall.  */
-
-#if FFETARGET_okREAL2
-bool
-ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer,
-		 ffelexToken decimal, ffelexToken fraction,
-		 ffelexToken exponent, ffelexToken exponent_sign,
-		 ffelexToken exponent_digits)
-{
-  size_t sz = 1;		/* Allow room for '\0' byte at end. */
-  char *ptr = &ffetarget_string_[0];
-  char *p = ptr;
-  char *q;
-
-#define dotok(x) if (x != NULL) ++sz;
-#define dotoktxt(x) if (x != NULL) sz += ffelex_token_length(x)
-
-  dotoktxt (integer);
-  dotok (decimal);
-  dotoktxt (fraction);
-  dotoktxt (exponent);
-  dotok (exponent_sign);
-  dotoktxt (exponent_digits);
-
-#undef dotok
-#undef dotoktxt
-
-  if (sz > ARRAY_SIZE (ffetarget_string_))
-    p = ptr = malloc_new_ks (malloc_pool_image (), "ffetarget_real1", sz);
-
-#define dotoktxt(x) if (x != NULL)				   \
-		  {						   \
-		  for (q = ffelex_token_text(x); *q != '\0'; ++q)  \
-		    *p++ = *q;					   \
-		  }
-#define dotoktxtexp(x) if (x != NULL)				       \
-		  {						       \
-		  *p++ = 'E';					       \
-		  for (q = ffelex_token_text(x) + 1; *q != '\0'; ++q)  \
-		    *p++ = *q;					       \
-		  }
-
-  dotoktxt (integer);
-
-  if (decimal != NULL)
-    *p++ = '.';
-
-  dotoktxt (fraction);
-  dotoktxtexp (exponent);
-
-  if (exponent_sign != NULL)
-    {
-      if (ffelex_token_type (exponent_sign) == FFELEX_typePLUS)
-	*p++ = '+';
-      else
-	{
-	  assert (ffelex_token_type (exponent_sign) == FFELEX_typeMINUS);
-	  *p++ = '-';
-	}
-    }
-
-  dotoktxt (exponent_digits);
-
-#undef dotoktxt
-
-  *p = '\0';
-
-  {
-    REAL_VALUE_TYPE rv;
-    real_from_string (&rv, ptr);
-    ffetarget_make_real2 (value, rv);
-  }
-
-  if (sz > ARRAY_SIZE (ffetarget_string_))
-    malloc_kill_ks (malloc_pool_image (), ptr, sz);
-
-  return TRUE;
-}
-
-#endif
-bool
-ffetarget_typeless_binary (ffetargetTypeless *xvalue, ffelexToken token)
-{
-  char *p;
-  char c;
-  ffetargetTypeless value = 0;
-  ffetargetTypeless new_value = 0;
-  bool bad_digit = FALSE;
-  bool overflow = FALSE;
-
-  p = ffelex_token_text (token);
-
-  for (c = *p; c != '\0'; c = *++p)
-    {
-      new_value <<= 1;
-      if ((new_value >> 1) != value)
-	overflow = TRUE;
-      if (ISDIGIT (c))
-	new_value += c - '0';
-      else
-	bad_digit = TRUE;
-      value = new_value;
-    }
-
-  if (bad_digit)
-    {
-      ffebad_start (FFEBAD_INVALID_TYPELESS_BINARY_DIGIT);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-    }
-  else if (overflow)
-    {
-      ffebad_start (FFEBAD_TYPELESS_OVERFLOW);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-    }
-
-  *xvalue = value;
-
-  return !bad_digit && !overflow;
-}
-
-bool
-ffetarget_typeless_octal (ffetargetTypeless *xvalue, ffelexToken token)
-{
-  char *p;
-  char c;
-  ffetargetTypeless value = 0;
-  ffetargetTypeless new_value = 0;
-  bool bad_digit = FALSE;
-  bool overflow = FALSE;
-
-  p = ffelex_token_text (token);
-
-  for (c = *p; c != '\0'; c = *++p)
-    {
-      new_value <<= 3;
-      if ((new_value >> 3) != value)
-	overflow = TRUE;
-      if (ISDIGIT (c))
-	new_value += c - '0';
-      else
-	bad_digit = TRUE;
-      value = new_value;
-    }
-
-  if (bad_digit)
-    {
-      ffebad_start (FFEBAD_INVALID_TYPELESS_OCTAL_DIGIT);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-    }
-  else if (overflow)
-    {
-      ffebad_start (FFEBAD_TYPELESS_OVERFLOW);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-    }
-
-  *xvalue = value;
-
-  return !bad_digit && !overflow;
-}
-
-bool
-ffetarget_typeless_hex (ffetargetTypeless *xvalue, ffelexToken token)
-{
-  char *p;
-  char c;
-  ffetargetTypeless value = 0;
-  ffetargetTypeless new_value = 0;
-  bool bad_digit = FALSE;
-  bool overflow = FALSE;
-
-  p = ffelex_token_text (token);
-
-  for (c = *p; c != '\0'; c = *++p)
-    {
-      new_value <<= 4;
-      if ((new_value >> 4) != value)
-	overflow = TRUE;
-      if (hex_p (c))
-	new_value += hex_value (c);
-      else
-	bad_digit = TRUE;
-      value = new_value;
-    }
-
-  if (bad_digit)
-    {
-      ffebad_start (FFEBAD_INVALID_TYPELESS_HEX_DIGIT);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-    }
-  else if (overflow)
-    {
-      ffebad_start (FFEBAD_TYPELESS_OVERFLOW);
-      ffebad_here (0, ffelex_token_where_line (token),
-		   ffelex_token_where_column (token));
-      ffebad_finish ();
-    }
-
-  *xvalue = value;
-
-  return !bad_digit && !overflow;
-}
-
-void
-ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val)
-{
-  if (val.length != 0)
-    malloc_verify_kp (pool, val.text, val.length);
-}
-
-/* This is like memcpy.	 It is needed because some systems' header files
-   don't declare memcpy as a function but instead
-   "#define memcpy(to,from,len) something".  */
-
-void *
-ffetarget_memcpy_ (void *dst, void *src, size_t len)
-{
-#ifdef CROSS_COMPILE
-  /* HOST_WORDS_BIG_ENDIAN corresponds to both WORDS_BIG_ENDIAN and
-     BYTES_BIG_ENDIAN (i.e. there are no HOST_ macros to represent a
-     difference in the two latter).  */
-  int host_words_big_endian =
-#ifndef HOST_WORDS_BIG_ENDIAN
-    0
-#else
-    HOST_WORDS_BIG_ENDIAN
-#endif
-    ;
-
-  /* This is just hands thrown up in the air over bits coming through this
-     function representing a number being memcpy:d as-is from host to
-     target.  We can't generally adjust endianness here since we don't
-     know whether it's an integer or floating point number; they're passed
-     differently.  Better to not emit code at all than to emit wrong code.
-     We will get some false hits because some data coming through here
-     seems to be just character vectors, but often enough it's numbers,
-     for instance in g77.f-torture/execute/980628-[4-6].f and alpha2.f.
-     Still, we compile *some* code.  FIXME: Rewrite handling of numbers.  */
-  if (!WORDS_BIG_ENDIAN != !host_words_big_endian
-      || !BYTES_BIG_ENDIAN != !host_words_big_endian)
-    sorry ("data initializer on host with different endianness");
-
-#endif /* CROSS_COMPILE */
-
-  return (void *) memcpy (dst, src, len);
-}
-
-/* ffetarget_num_digits_ -- Determine number of non-space characters in token
-
-   ffetarget_num_digits_(token);
-
-   All non-spaces are assumed to be binary, octal, or hex digits.  */
-
-int
-ffetarget_num_digits_ (ffelexToken token)
-{
-  int i;
-  char *c;
-
-  switch (ffelex_token_type (token))
-    {
-    case FFELEX_typeNAME:
-    case FFELEX_typeNUMBER:
-      return ffelex_token_length (token);
-
-    case FFELEX_typeCHARACTER:
-      i = 0;
-      for (c = ffelex_token_text (token); *c != '\0'; ++c)
-	{
-	  if (*c != ' ')
-	    ++i;
-	}
-      return i;
-
-    default:
-      assert ("weird token" == NULL);
-      return 1;
-    }
-}
diff --git a/gcc/f/target.h b/gcc/f/target.h
deleted file mode 100644
index 8ec73ad..0000000
--- a/gcc/f/target.h
+++ /dev/null
@@ -1,1433 +0,0 @@
-/* target.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 2002, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      target.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_TARGET_H
-#define GCC_F_TARGET_H
-
-#ifndef TREE_CODE
-#include "tree.h"
-#endif
-
-/* Simple definitions and enumerations. */
-
-#define FFETARGET_charactersizeNONE (-1)
-#ifndef FFETARGET_charactersizeMAXIMUM
-#define FFETARGET_charactersizeMAXIMUM 2147483647
-#endif
-
-#ifndef FFETARGET_defaultIS_90
-#define FFETARGET_defaultIS_90 0
-#endif
-#ifndef FFETARGET_defaultIS_AUTOMATIC
-#define FFETARGET_defaultIS_AUTOMATIC 1
-#endif
-#ifndef FFETARGET_defaultIS_BACKSLASH
-#define FFETARGET_defaultIS_BACKSLASH 1
-#endif
-#ifndef FFETARGET_defaultIS_INIT_LOCAL_ZERO
-#define FFETARGET_defaultIS_INIT_LOCAL_ZERO 0
-#endif
-#ifndef FFETARGET_defaultIS_DOLLAR_OK
-#define FFETARGET_defaultIS_DOLLAR_OK 0
-#endif
-#ifndef FFETARGET_defaultIS_F2C
-#define FFETARGET_defaultIS_F2C 1
-#endif
-#ifndef FFETARGET_defaultIS_F2C_LIBRARY
-#define FFETARGET_defaultIS_F2C_LIBRARY 1
-#endif
-#ifndef FFETARGET_defaultIS_FREE_FORM
-#define FFETARGET_defaultIS_FREE_FORM 0
-#endif
-#ifndef FFETARGET_defaultIS_PEDANTIC
-#define FFETARGET_defaultIS_PEDANTIC 0
-#endif
-#ifndef FFETARGET_defaultCASE_INTRIN
-#define FFETARGET_defaultCASE_INTRIN FFE_caseLOWER
-#endif
-#ifndef FFETARGET_defaultCASE_MATCH
-#define FFETARGET_defaultCASE_MATCH FFE_caseLOWER
-#endif
-#ifndef FFETARGET_defaultCASE_SOURCE
-#define FFETARGET_defaultCASE_SOURCE FFE_caseLOWER
-#endif
-#ifndef FFETARGET_defaultCASE_SYMBOL
-#define FFETARGET_defaultCASE_SYMBOL FFE_caseNONE
-#endif
-
-#ifndef FFETARGET_defaultFIXED_LINE_LENGTH
-#define FFETARGET_defaultFIXED_LINE_LENGTH 72
-#endif
-
-/* 1 if external Fortran names ("FOO" in SUBROUTINE FOO, COMMON /FOO/,
-   and even enforced/default-for-unnamed PROGRAM, blank-COMMON, and
-   BLOCK DATA names, but not names of library functions implementing
-   intrinsics or names of local/internal variables) should have an
-   underscore appended (for compatibility with existing systems).  */
-
-#ifndef FFETARGET_defaultEXTERNAL_UNDERSCORED
-#define FFETARGET_defaultEXTERNAL_UNDERSCORED 1
-#endif
-
-/* 1 if external Fortran names with underscores already in them should
-   have an extra underscore appended (in addition to the one they
-   might already have appened if FFETARGET_defaultEXTERNAL_UNDERSCORED). */
-
-#ifndef FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED
-#define FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED 1
-#endif
-
-/* If FFETARGET_defaultEXTERNAL_UNDERSCORED is 0, the following definitions
-   might also need to be overridden to make g77 objects compatible with
-   f2c+gcc objects.  Although I don't think the unnamed BLOCK DATA one
-   is an issue at all.  Of course, on some systems it isn't f2c
-   compatibility that is the issue -- maybe compatibility with some
-   other compiler(s).  I don't know what to recommend for systems where
-   there is no existing Fortran compiler -- I suppose porting f2c and
-   pretending it's the existing one is best for now.  */
-
-/* 1 if the "FOO" in "PROGRAM FOO" should be overridden and a particular
-   name imposed in place of it in the actual code (normally the case,
-   because the library's main entry point on most systems calls the main
-   function by a particular name).  Someday g77 might do the f2c trick
-   of also outputting a "FOO" procedure that just calls the main procedure,
-   but that'll wait until somebody shows why it is needed.  */
-
-#ifndef FFETARGET_isENFORCED_MAIN
-#define FFETARGET_isENFORCED_MAIN 1
-#endif
-
-/* The enforced name of the main program if ENFORCED_MAIN is 1.  */
-
-#ifndef FFETARGET_nameENFORCED_MAIN_NAME
-#define FFETARGET_nameENFORCED_MAIN_NAME "MAIN__"
-#endif
-
-/* The name used for an unnamed main program if ENFORCED_MAIN is 0.  */
-
-#ifndef FFETARGET_nameUNNAMED_MAIN
-#define FFETARGET_nameUNNAMED_MAIN "MAIN__"
-#endif
-
-/* The name used for an unnamed block data program.  */
-
-#ifndef FFETARGET_nameUNNAMED_BLOCK_DATA
-#define FFETARGET_nameUNNAMED_BLOCK_DATA "_BLOCK_DATA__"
-#endif
-
-/* The name used for blank common.  */
-
-#ifndef FFETARGET_nameBLANK_COMMON
-#define FFETARGET_nameBLANK_COMMON "_BLNK__"
-#endif
-
-#ifndef FFETARGET_integerSMALLEST_POSITIVE
-#define FFETARGET_integerSMALLEST_POSITIVE 0
-#endif
-#ifndef FFETARGET_integerLARGEST_POSITIVE
-#define FFETARGET_integerLARGEST_POSITIVE 2147483647
-#endif
-#ifndef FFETARGET_integerBIG_MAGICAL
-#define FFETARGET_integerBIG_MAGICAL 020000000000	/* 2147483648 */
-#endif
-#ifndef FFETARGET_integerALMOST_BIG_MAGICAL
-#define FFETARGET_integerALMOST_BIG_MAGICAL 214748364
-#endif
-#ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY
-#define FFETARGET_integerALMOST_BIG_OVERFLOW_BINARY 0x80000000
-#endif
-#ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_HEX
-#define FFETARGET_integerALMOST_BIG_OVERFLOW_HEX 0x10000000
-#endif
-#ifndef FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL
-#define FFETARGET_integerALMOST_BIG_OVERFLOW_OCTAL 0x20000000
-#endif
-#ifndef FFETARGET_integerFINISH_BIG_MAGICAL
-#define FFETARGET_integerFINISH_BIG_MAGICAL 8
-#endif
-#ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY
-#define FFETARGET_integerFINISH_BIG_OVERFLOW_BINARY 0
-#endif
-#ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_HEX
-#define FFETARGET_integerFINISH_BIG_OVERFLOW_HEX 0
-#endif
-#ifndef FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL
-#define FFETARGET_integerFINISH_BIG_OVERFLOW_OCTAL 0
-#endif
-
-#ifndef FFETARGET_offsetNONE
-#define FFETARGET_offsetNONE 0	/* Not used by FFE, for backend if needed. */
-#endif
-
-#define FFETARGET_okINTEGER1 1
-#define FFETARGET_okINTEGER2 1
-#define FFETARGET_okINTEGER3 1
-#define FFETARGET_okINTEGER4 1
-#define FFETARGET_okLOGICAL1 1
-#define FFETARGET_okLOGICAL2 1
-#define FFETARGET_okLOGICAL3 1
-#define FFETARGET_okLOGICAL4 1
-#define FFETARGET_okREAL1 1
-#define FFETARGET_okREAL2 1
-#define FFETARGET_okREAL3 0
-#define FFETARGET_okREALQUAD FFETARGET_okREAL3
-#define FFETARGET_okCOMPLEX1 1
-#define FFETARGET_okCOMPLEX2 1
-#define FFETARGET_okCOMPLEX3 0
-#define FFETARGET_okCOMPLEXDOUBLE FFETARGET_okCOMPLEX2
-#define FFETARGET_okCOMPLEXQUAD FFETARGET_okCOMPLEX3
-#define FFETARGET_okCHARACTER1 1
-
-#define FFETARGET_f2cTYUNKNOWN 0
-#define FFETARGET_f2cTYADDR 1
-#define FFETARGET_f2cTYSHORT 2
-#define FFETARGET_f2cTYLONG 3
-#define FFETARGET_f2cTYREAL 4
-#define FFETARGET_f2cTYDREAL 5
-#define FFETARGET_f2cTYCOMPLEX 6
-#define FFETARGET_f2cTYDCOMPLEX 7
-#define FFETARGET_f2cTYLOGICAL 8
-#define FFETARGET_f2cTYCHAR 9
-#define FFETARGET_f2cTYSUBR 10
-#define FFETARGET_f2cTYINT1 11
-#define FFETARGET_f2cTYLOGICAL1 12
-#define FFETARGET_f2cTYLOGICAL2 13
-#define FFETARGET_f2cTYQUAD 14
-
-#if (!defined(__alpha__) \
-     && (!defined(__hppa__) || !defined(__LP64__)) \
-     && (!defined(__ia64__) || !defined(__LP64__)) \
-     && !defined(__MMIX__) \
-     && (!defined (_ARCH_PPC) || !defined (__64BIT__)) \
-     && !defined(__powerpc64__) \
-     && !defined(__s390x__) \
-     && (!defined(__sparc__) || (!defined(__sparcv9) && !defined(__arch64__)))\
-     && !defined(__x86_64__))
-#define FFETARGET_32bit_longs
-#endif
-
-/* Typedefs. */
-
-typedef unsigned char ffetargetAlign;	/* ffetargetOffset for alignment. */
-#define ffetargetAlign_f ""
-typedef long ffetargetCharacterSize;
-#define ffetargetCharacterSize_f "l"
-typedef void (*ffetargetCopyfunc) (void *, void *, size_t);
-typedef ffetargetCharacterSize ffetargetHollerithSize;
-#define ffetargetHollerithSize_f "l"
-typedef long long ffetargetOffset;
-#define ffetargetOffset_f "ll"
-
-#if FFETARGET_okINTEGER1
-#ifdef FFETARGET_32bit_longs
-typedef long int ffetargetInteger1;
-#define ffetargetInteger1_f "l"
-#else
-typedef int ffetargetInteger1;
-#define ffetargetInteger1_f ""
-#endif
-#endif
-#if FFETARGET_okINTEGER2
-typedef signed char ffetargetInteger2;
-#define ffetargetInteger2_f ""
-#endif
-#if FFETARGET_okINTEGER3
-typedef short int ffetargetInteger3;
-#define ffetargetInteger3_f ""
-#endif
-#if FFETARGET_okINTEGER4
-typedef long long int ffetargetInteger4;
-#define ffetargetInteger4_f "ll"
-#endif
-#if FFETARGET_okLOGICAL1
-#ifdef FFETARGET_32bit_longs
-typedef long int ffetargetLogical1;
-#define ffetargetLogical1_f "l"
-#else
-typedef int ffetargetLogical1;
-#define ffetargetLogical1_f ""
-#endif
-#endif
-#if FFETARGET_okLOGICAL2
-typedef signed char ffetargetLogical2;
-#define ffetargetLogical2_f ""
-#endif
-#if FFETARGET_okLOGICAL3
-typedef short int ffetargetLogical3;
-#define ffetargetLogical3_f ""
-#endif
-#if FFETARGET_okLOGICAL4
-typedef long long int ffetargetLogical4;
-#define ffetargetLogical4_f "ll"
-#endif
-#if FFETARGET_okREAL1
-typedef int ffetargetReal1;
-#define ffetargetReal1_f ""
-#define ffetarget_cvt_r1_to_rv_(in)					\
-  ({ REAL_VALUE_TYPE _rv;						\
-     long _in = (in);							\
-     real_from_target (&_rv, &_in, mode_for_size (32, MODE_FLOAT, 0));	\
-     _rv; })
-#define ffetarget_cvt_rv_to_r1_(in, out) \
-  ({ long _tmp; \
-     REAL_VALUE_TO_TARGET_SINGLE ((in), _tmp); \
-     (out) = (ffetargetReal1) _tmp; })
-#endif
-#if FFETARGET_okREAL2
-typedef struct { int v[2]; } ffetargetReal2;
-#define ffetargetReal2_f ""
-#define ffetarget_cvt_r2_to_rv_(in)					\
-  ({ REAL_VALUE_TYPE _rv; long _tmp[2];					\
-     _tmp[0] = (in)[0]; _tmp[1] = (in)[1];				\
-     real_from_target (&_rv, _tmp, mode_for_size (64, MODE_FLOAT, 0));	\
-     _rv; })
-#define ffetarget_cvt_rv_to_r2_(in, out)				\
-  ({ long _tmp[2];							\
-     REAL_VALUE_TO_TARGET_DOUBLE ((in), _tmp);				\
-     (out)[0] = (int)_tmp[0]; (out)[1] = (int)_tmp[1]; })
-#endif
-#if FFETARGET_okREAL3
-typedef long ffetargetReal3[?];
-?
-#endif
-#if FFETARGET_okCOMPLEX1
-struct _ffetarget_complex_1_
-  {
-    ffetargetReal1 real;
-    ffetargetReal1 imaginary;
-  };
-typedef struct _ffetarget_complex_1_ ffetargetComplex1;
-#endif
-#if FFETARGET_okCOMPLEX2
-struct _ffetarget_complex_2_
-  {
-    ffetargetReal2 real;
-    ffetargetReal2 imaginary;
-  };
-typedef struct _ffetarget_complex_2_ ffetargetComplex2;
-#endif
-#if FFETARGET_okCOMPLEX3
-struct _ffetarget_complex_3_
-  {
-    ffetargetReal3 real;
-    ffetargetReal3 imaginary;
-  };
-typedef struct _ffetarget_complex_3_ ffetargetComplex3;
-#endif
-#if FFETARGET_okCHARACTER1
-struct _ffetarget_char_1_
-  {
-    ffetargetCharacterSize length;
-    unsigned char *text;
-  };
-typedef struct _ffetarget_char_1_ ffetargetCharacter1;
-typedef unsigned char ffetargetCharacterUnit1;
-#endif
-
-typedef unsigned long long int ffetargetTypeless;
-
-struct _ffetarget_hollerith_
-  {
-    ffetargetHollerithSize length;
-    unsigned char *text;
-  };
-typedef struct _ffetarget_hollerith_ ffetargetHollerith;
-
-typedef ffetargetCharacter1 ffetargetCharacterDefault;
-typedef ffetargetComplex1 ffetargetComplexDefault;
-#if FFETARGET_okCOMPLEXDOUBLE
-typedef ffetargetComplex2 ffetargetComplexDouble;
-#endif
-#if FFETARGET_okCOMPLEXQUAD
-typedef ffetargetComplex3 ffetargetComplexQuad;
-#endif
-typedef ffetargetInteger1 ffetargetIntegerDefault;
-#define ffetargetIntegerDefault_f ffetargetInteger1_f
-typedef ffetargetLogical1 ffetargetLogicalDefault;
-#define ffetargetLogicalDefault_f ffetargetLogical1_f
-typedef ffetargetReal1 ffetargetRealDefault;
-#define ffetargetRealDefault_f ffetargetReal1_f
-typedef ffetargetReal2 ffetargetRealDouble;
-#define ffetargetRealDouble_f ffetargetReal2_f
-#if FFETARGET_okREALQUAD
-typedef ffetargetReal3 ffetargetRealQuad;
-#define ffetargetRealQuad_f ffetargetReal3_f
-#endif
-
-/* Include files needed by this one. */
-
-#include "bad.h"
-#include "info.h"
-#include "lex.h"
-#include "malloc.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-extern char ffetarget_string_[40];	/* Temp for ascii-to-double (atof). */
-extern HOST_WIDE_INT ffetarget_long_val_;
-extern HOST_WIDE_INT ffetarget_long_junk_;
-
-/* Declare functions with prototypes. */
-
-void ffetarget_aggregate_info (ffeinfoBasictype *ebt, ffeinfoKindtype *ekt,
-			       ffetargetAlign *units, ffeinfoBasictype abt,
-			       ffeinfoKindtype akt);
-ffetargetAlign ffetarget_align (ffetargetAlign *updated_alignment,
-				ffetargetAlign *updated_modulo,
-				ffetargetOffset offset,
-				ffetargetAlign alignment,
-				ffetargetAlign modulo);
-#if FFETARGET_okCHARACTER1
-bool ffetarget_character1 (ffetargetCharacter1 *val, ffelexToken character,
-			   mallocPool pool);
-int ffetarget_cmp_character1 (ffetargetCharacter1 l, ffetargetCharacter1 r);
-ffebad ffetarget_concatenate_character1 (ffetargetCharacter1 *res,
-					 ffetargetCharacter1 l,
-					 ffetargetCharacter1 r,
-					 mallocPool pool,
-					 ffetargetCharacterSize *len);
-ffebad ffetarget_convert_character1_character1 (ffetargetCharacter1 *res,
-					    ffetargetCharacterSize res_size,
-						ffetargetCharacter1 l,
-						mallocPool pool);
-ffebad ffetarget_convert_character1_hollerith (ffetargetCharacter1 *res,
-					    ffetargetCharacterSize res_size,
-					       ffetargetHollerith l,
-					       mallocPool pool);
-ffebad ffetarget_convert_character1_integer4 (ffetargetCharacter1 *res,
-					      ffetargetCharacterSize res_size,
-					      ffetargetInteger4 l,
-					      mallocPool pool);
-ffebad ffetarget_convert_character1_logical4 (ffetargetCharacter1 *res,
-					      ffetargetCharacterSize res_size,
-					      ffetargetLogical4 l,
-					      mallocPool pool);
-ffebad ffetarget_convert_character1_typeless (ffetargetCharacter1 *res,
-					    ffetargetCharacterSize res_size,
-					      ffetargetTypeless l,
-					      mallocPool pool);
-ffebad ffetarget_eq_character1 (bool *res, ffetargetCharacter1 l,
-				ffetargetCharacter1 r);
-ffebad ffetarget_le_character1 (bool *res, ffetargetCharacter1 l,
-				ffetargetCharacter1 r);
-ffebad ffetarget_ge_character1 (bool *res, ffetargetCharacter1 l,
-				ffetargetCharacter1 r);
-ffebad ffetarget_gt_character1 (bool *res, ffetargetCharacter1 l,
-				ffetargetCharacter1 r);
-ffebad ffetarget_lt_character1 (bool *res, ffetargetCharacter1 l,
-				ffetargetCharacter1 r);
-ffebad ffetarget_ne_character1 (bool *res, ffetargetCharacter1 l,
-				ffetargetCharacter1 r);
-ffebad ffetarget_substr_character1 (ffetargetCharacter1 *res,
-				    ffetargetCharacter1 l,
-				    ffetargetCharacterSize first,
-				    ffetargetCharacterSize last,
-				    mallocPool pool,
-				    ffetargetCharacterSize *len);
-#endif
-int ffetarget_cmp_hollerith (ffetargetHollerith l, ffetargetHollerith r);
-bool ffetarget_hollerith (ffetargetHollerith *val, ffelexToken hollerith,
-			  mallocPool pool);
-int ffetarget_cmp_typeless (ffetargetTypeless l, ffetargetTypeless r);
-ffebad ffetarget_convert_any_character1_ (char *res, size_t size,
-					  ffetargetCharacter1 l);
-ffebad ffetarget_convert_any_hollerith_ (char *res, size_t size,
-					 ffetargetHollerith l);
-ffebad ffetarget_convert_any_typeless_ (char *res, size_t size,
-					ffetargetTypeless l);
-#if FFETARGET_okCOMPLEX1
-ffebad ffetarget_divide_complex1 (ffetargetComplex1 *res, ffetargetComplex1 l,
-				  ffetargetComplex1 r);
-#endif
-#if FFETARGET_okCOMPLEX2
-ffebad ffetarget_divide_complex2 (ffetargetComplex2 *res, ffetargetComplex2 l,
-				  ffetargetComplex2 r);
-#endif
-#if FFETARGET_okCOMPLEX3
-ffebad ffetarget_divide_complex3 (ffetargetComplex3 *res, ffetargetComplex3 l,
-				  ffetargetComplex3 r);
-#endif
-#if FFETARGET_okINTEGER1
-bool ffetarget_integer1 (ffetargetInteger1 *val, ffelexToken integer);
-#endif
-#if FFETARGET_okINTEGER2
-bool ffetarget_integer2 (ffetargetInteger2 *val, ffelexToken integer);
-#endif
-#if FFETARGET_okINTEGER3
-bool ffetarget_integer3 (ffetargetInteger3 *val, ffelexToken integer);
-#endif
-#if FFETARGET_okINTEGER4
-bool ffetarget_integer4 (ffetargetInteger4 *val, ffelexToken integer);
-#endif
-bool ffetarget_integerbinary (ffetargetIntegerDefault *val,
-			     ffelexToken integer);
-bool ffetarget_integerhex (ffetargetIntegerDefault *val,
-			     ffelexToken integer);
-bool ffetarget_integeroctal (ffetargetIntegerDefault *val,
-			     ffelexToken integer);
-void ffetarget_integer_bad_magical (ffelexToken t);
-void ffetarget_integer_bad_magical_binary (ffelexToken integer, ffelexToken minus);
-void ffetarget_integer_bad_magical_precedence (ffelexToken integer,
-					       ffelexToken uminus,
-					       ffelexToken higher_op);
-void ffetarget_integer_bad_magical_precedence_binary (ffelexToken integer,
-						      ffelexToken minus,
-						      ffelexToken higher_op);
-#if FFETARGET_okCHARACTER1
-bool ffetarget_iszero_character1 (ffetargetCharacter1 constant);
-#endif
-bool ffetarget_iszero_hollerith (ffetargetHollerith constant);
-void ffetarget_layout (const char *error_text, ffetargetAlign *alignment,
-		       ffetargetAlign *modulo, ffetargetOffset *size,
-		       ffeinfoBasictype bt, ffeinfoKindtype kt,
-		       ffetargetCharacterSize charsize,
-		       ffetargetIntegerDefault num_elements);
-#if FFETARGET_okCOMPLEX1
-ffebad ffetarget_multiply_complex1 (ffetargetComplex1 *res,
-				    ffetargetComplex1 l,
-				    ffetargetComplex1 r);
-#endif
-#if FFETARGET_okCOMPLEX2
-ffebad ffetarget_multiply_complex2 (ffetargetComplex2 *res,
-				    ffetargetComplex2 l,
-				    ffetargetComplex2 r);
-#endif
-#if FFETARGET_okCOMPLEX3
-ffebad ffetarget_multiply_complex3 (ffetargetComplex3 *res,
-				    ffetargetComplex3 l,
-				    ffetargetComplex3 r);
-#endif
-ffebad ffetarget_power_complexdefault_integerdefault (ffetargetComplexDefault *res,
-						  ffetargetComplexDefault l,
-						 ffetargetIntegerDefault r);
-#if FFETARGET_okCOMPLEXDOUBLE
-ffebad ffetarget_power_complexdouble_integerdefault (ffetargetComplexDouble *res,
-						   ffetargetComplexDouble l,
-						 ffetargetIntegerDefault r);
-#endif
-ffebad ffetarget_power_integerdefault_integerdefault (ffetargetIntegerDefault *res,
-						  ffetargetIntegerDefault l,
-						 ffetargetIntegerDefault r);
-ffebad ffetarget_power_realdefault_integerdefault (ffetargetRealDefault *res,
-						   ffetargetRealDefault l,
-						 ffetargetIntegerDefault r);
-ffebad ffetarget_power_realdouble_integerdefault (ffetargetRealDouble *res,
-						  ffetargetRealDouble l,
-						  ffetargetIntegerDefault r);
-void ffetarget_print_binary (FILE *f, ffetargetTypeless val);
-void ffetarget_print_character1 (FILE *f, ffetargetCharacter1 val);
-void ffetarget_print_hollerith (FILE *f, ffetargetHollerith val);
-void ffetarget_print_octal (FILE *f, ffetargetTypeless val);
-void ffetarget_print_hex (FILE *f, ffetargetTypeless val);
-#if FFETARGET_okREAL1
-bool ffetarget_real1 (ffetargetReal1 *value, ffelexToken integer,
-		      ffelexToken decimal, ffelexToken fraction,
-		      ffelexToken exponent, ffelexToken exponent_sign,
-		      ffelexToken exponent_digits);
-#endif
-#if FFETARGET_okREAL2
-bool ffetarget_real2 (ffetargetReal2 *value, ffelexToken integer,
-		      ffelexToken decimal, ffelexToken fraction,
-		      ffelexToken exponent, ffelexToken exponent_sign,
-		      ffelexToken exponent_digits);
-#endif
-#if FFETARGET_okREAL3
-bool ffetarget_real3 (ffetargetReal3 *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);
-void ffetarget_verify_character1 (mallocPool pool, ffetargetCharacter1 val);
-int ffetarget_num_digits_ (ffelexToken t);
-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, (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; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
-     li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
-     ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
-     REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
-     REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
-     ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
-     ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
-     FFEBAD; })
-#define ffetarget_add_complex2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
-     li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
-     ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
-     REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
-     REAL_ARITHMETIC (resi, PLUS_EXPR, li, ri); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
-     ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
-     FFEBAD; })
-#define ffetarget_add_integer1(res,l,r) (*(res) = (l) + (r), FFEBAD)
-#define ffetarget_add_integer2(res,l,r) (*(res) = (l) + (r), FFEBAD)
-#define ffetarget_add_integer3(res,l,r) (*(res) = (l) + (r), FFEBAD)
-#define ffetarget_add_integer4(res,l,r) (*(res) = (l) + (r), FFEBAD)
-#define ffetarget_add_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
-     ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
-     FFEBAD; })
-#define ffetarget_add_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     REAL_ARITHMETIC (resr, PLUS_EXPR, lr, rr); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
-     FFEBAD; })
-#define ffetarget_aggregate_ptr_memcpy(dbt,dkt,sbt,skt) \
-  ((ffetargetCopyfunc) ffetarget_memcpy_)
-#define ffetarget_and_integer1(res,l,r) (*(res) = (l) & (r), FFEBAD)
-#define ffetarget_and_integer2(res,l,r) (*(res) = (l) & (r), FFEBAD)
-#define ffetarget_and_integer3(res,l,r) (*(res) = (l) & (r), FFEBAD)
-#define ffetarget_and_integer4(res,l,r) (*(res) = (l) & (r), FFEBAD)
-#define ffetarget_and_logical1(res,l,r) (*(res) = (l) && (r), FFEBAD)
-#define ffetarget_and_logical2(res,l,r) (*(res) = (l) && (r), FFEBAD)
-#define ffetarget_and_logical3(res,l,r) (*(res) = (l) && (r), FFEBAD)
-#define ffetarget_and_logical4(res,l,r) (*(res) = (l) && (r), FFEBAD)
-#define ffetarget_binarymil(v,t) ffetarget_typeless_binary (v, t)
-#define ffetarget_binaryvxt(v,t) ffetarget_typeless_binary (v, t)
-#define ffetarget_cmp_integer1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_integer2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_integer3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_integer4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_logical1(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_logical2(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_logical3(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_logical4(l,r) ((l) == (r) ? 0 : ((l) < (r) ? -1 : 1))
-#define ffetarget_cmp_real1(l,r) memcmp (&(l), &(r), sizeof(l))
-#define ffetarget_cmp_real2(l,r) memcmp (&(l), &(r), sizeof(l))
-#define ffetarget_cmp_real3(l,r) memcmp (&(l), &(r), sizeof(l))
-#define ffetarget_cmp_typeless(l,r) \
-  memcmp (&(l), &(r), sizeof ((l)))
-#define ffetarget_convert_character1_integer1(res,res_size,l,pool) \
-        ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
-#define ffetarget_convert_character1_integer2(res,res_size,l,pool) \
-        ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
-#define ffetarget_convert_character1_integer3(res,res_size,l,pool) \
-        ffetarget_convert_character1_integer4(res,res_size,(ffetargetInteger4)l,pool)
-#define ffetarget_convert_character1_logical1(res,res_size,l,pool) \
-        ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
-#define ffetarget_convert_character1_logical2(res,res_size,l,pool) \
-        ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
-#define ffetarget_convert_character1_logical3(res,res_size,l,pool) \
-        ffetarget_convert_character1_logical4(res,res_size,(ffetargetLogical4)l,pool)
-#define ffetarget_convert_complex1_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_complex1_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_complex1_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_complex1_complex2(res,l) \
-  ({ REAL_VALUE_TYPE lr, li; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
-     li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
-     ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
-     ffetarget_cvt_rv_to_r1_ (li, (res)->imaginary), \
-     FFEBAD; })
-#define ffetarget_convert_complex1_integer(res,l) \
-  ({ REAL_VALUE_TYPE resi, resr; \
-     ffetargetInteger1 lf = (l); \
-     FFETARGET_REAL_VALUE_FROM_INT_ (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_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) \
-  ({ 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), \
-   FFEBAD)
-#define ffetarget_convert_complex1_real2(res,l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     ffetarget_cvt_rv_to_r1_ (lr, (res)->real); \
-     ffetarget_cvt_rv_to_r1_ (dconst0, (res)->imaginary), \
-     FFEBAD; })
-#define ffetarget_convert_complex2_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_complex2_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_complex2_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_complex2_complex1(res,l) \
-  ({ REAL_VALUE_TYPE lr, li; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
-     li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
-     ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
-     ffetarget_cvt_rv_to_r2_ (li, &((res)->imaginary.v[0])), \
-     FFEBAD; })
-#define ffetarget_convert_complex2_integer(res,l) \
-  ({ REAL_VALUE_TYPE resi, resr; \
-     ffetargetInteger1 lf = (l); \
-     FFETARGET_REAL_VALUE_FROM_INT_ (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_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) \
-  ({ 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); \
-     ffetarget_cvt_rv_to_r2_ (lr, &((res)->real.v[0])); \
-     ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
-     FFEBAD; })
-#define ffetarget_convert_complex2_real2(res,l) \
-  ((res)->real = (l), \
-   ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->imaginary.v[0])), \
-   FFEBAD)
-#define ffetarget_convert_integer2_character1(res,l) \
-        ffetarget_convert_integer1_character1(res,l)
-#define ffetarget_convert_integer2_complex1(res,l) \
-        ffetarget_convert_integer1_complex1(res,l)
-#define ffetarget_convert_integer2_complex2(res,l) \
-        ffetarget_convert_integer1_complex2(res,l)
-#define ffetarget_convert_integer2_hollerith(res,l) \
-        ffetarget_convert_integer1_hollerith(res,l)
-#define ffetarget_convert_integer2_integer1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer2_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer2_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer2_logical1(res,l) \
-        ffetarget_convert_integer1_logical1(res,l)
-#define ffetarget_convert_integer2_logical2(res,l) \
-        ffetarget_convert_integer2_logical1(res,l)
-#define ffetarget_convert_integer2_logical3(res,l) \
-        ffetarget_convert_integer2_logical1(res,l)
-#define ffetarget_convert_integer2_logical4(res,l) \
-        ffetarget_convert_integer2_logical1(res,l)
-#define ffetarget_convert_integer2_real1(res,l) \
-        ffetarget_convert_integer1_real1(res,l)
-#define ffetarget_convert_integer2_real2(res,l) \
-        ffetarget_convert_integer1_real2(res,l)
-#define ffetarget_convert_integer2_typeless(res,l) \
-        ffetarget_convert_integer1_typeless(res,l)
-#define ffetarget_convert_integer3_character1(res,l) \
-        ffetarget_convert_integer1_character1(res,l)
-#define ffetarget_convert_integer3_complex1(res,l) \
-        ffetarget_convert_integer1_complex1(res,l)
-#define ffetarget_convert_integer3_complex2(res,l) \
-        ffetarget_convert_integer1_complex2(res,l)
-#define ffetarget_convert_integer3_hollerith(res,l) \
-        ffetarget_convert_integer1_hollerith(res,l)
-#define ffetarget_convert_integer3_integer1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer3_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer3_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer3_logical1(res,l) \
-        ffetarget_convert_integer1_logical1(res,l)
-#define ffetarget_convert_integer3_logical2(res,l) \
-        ffetarget_convert_integer3_logical1(res,l)
-#define ffetarget_convert_integer3_logical3(res,l) \
-        ffetarget_convert_integer3_logical1(res,l)
-#define ffetarget_convert_integer3_logical4(res,l) \
-        ffetarget_convert_integer3_logical1(res,l)
-#define ffetarget_convert_integer3_real1(res,l) \
-        ffetarget_convert_integer1_real1(res,l)
-#define ffetarget_convert_integer3_real2(res,l) \
-        ffetarget_convert_integer1_real2(res,l)
-#define ffetarget_convert_integer3_typeless(res,l) \
-        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) \
-  ({ 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)
-#define ffetarget_convert_integer4_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer4_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer4_logical1(res,l) \
-        ffetarget_convert_integer1_logical1(res,l)
-#define ffetarget_convert_integer4_logical2(res,l) \
-        ffetarget_convert_integer1_logical1(res,l)
-#define ffetarget_convert_integer4_logical3(res,l) \
-        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) \
-  ({ 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) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical1_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical1_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical1_logical2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical1_logical3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical1_logical4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical1_integer1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical1_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical1_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical1_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical2_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical2_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical2_logical1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_logical3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_logical4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_integer1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical2_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical3_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical3_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical3_logical1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_logical2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_logical4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_integer1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical3_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical4_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical4_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_logical4_logical1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_logical2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_logical3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_integer1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_logical4_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_integer1_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_integer1_typeless(res,l) \
-  ffetarget_convert_any_typeless_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_integer1_integer2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_integer3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_integer4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_logical1(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_logical2(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_logical3(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_logical4(res,l) (*(res) = (l), FFEBAD)
-#define ffetarget_convert_integer1_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_long_val_; \
-     FFEBAD; })
-#define ffetarget_convert_integer1_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_long_val_; \
-     FFEBAD; })
-#define ffetarget_convert_integer1_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_long_val_; \
-     FFEBAD; })
-#define ffetarget_convert_integer1_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_long_val_; \
-     FFEBAD; })
-#define ffetarget_convert_real1_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_real1_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_real1_integer2(res,l) \
-        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) \
-  ({ 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)
-#define ffetarget_convert_real1_complex2(res,l) \
-  ffetarget_convert_real1_real2 ((res), (l).real)
-#define ffetarget_convert_real1_integer1(res,l) \
-  ({ REAL_VALUE_TYPE resr; \
-     ffetargetInteger1 lf = (l); \
-     FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 1); \
-     ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
-     FFEBAD; })
-#define ffetarget_convert_real1_real2(res,l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     ffetarget_cvt_rv_to_r1_ (lr, *(res)); \
-     FFEBAD; })
-#define ffetarget_convert_real2_character1(res,l) \
-  ffetarget_convert_any_character1_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_real2_hollerith(res,l) \
-  ffetarget_convert_any_hollerith_ ((char *) (res), sizeof(*(res)), l)
-#define ffetarget_convert_real2_integer2(res,l) \
-        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) \
-  ({ 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) \
-  ffetarget_convert_real2_real1 ((res), (l).real)
-#define ffetarget_convert_real2_complex2(res,l) (*(res) = (l).real, FFEBAD)
-#define ffetarget_convert_real2_integer(res,l) \
-  ({ REAL_VALUE_TYPE resr; \
-     ffetargetInteger1 lf = (l); \
-     FFETARGET_REAL_VALUE_FROM_INT_ (resr, lf, 2); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
-     FFEBAD; })
-#define ffetarget_convert_real2_integer1 ffetarget_convert_real2_integer
-#define ffetarget_convert_real2_real1(res,l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     ffetarget_cvt_rv_to_r2_ (lr, &((res)->v[0])); \
-     FFEBAD; })
-#define ffetarget_divide_integer1(res,l,r) \
-  (((r) == 0) ? (*(res) = 0, FFEBAD_DIV_BY_ZERO)  \
-   : (((r) == -1) ? (*(res) = -(l), FFEBAD)       \
-      : (*(res) = (l) / (r), FFEBAD)))
-#define ffetarget_divide_integer2(res,l,r) \
-        ffetarget_divide_integer1(res,l,r)
-#define ffetarget_divide_integer3(res,l,r) \
-        ffetarget_divide_integer1(res,l,r)
-#define ffetarget_divide_integer4(res,l,r) \
-        ffetarget_divide_integer1(res,l,r)
-#define ffetarget_divide_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     REAL_VALUES_EQUAL (rr, dconst0) \
-       ? ({ ffetarget_cvt_rv_to_r1_ (dconst0, *(res)); \
-	    FFEBAD_DIV_BY_ZERO; \
-	  }) \
-	 : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
-	      ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
-	      FFEBAD; \
-	    }); \
-	 })
-#define ffetarget_divide_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     REAL_VALUES_EQUAL (rr, dconst0) \
-       ? ({ ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0])); \
-	    FFEBAD_DIV_BY_ZERO; \
-	  }) \
-	 : ({ REAL_ARITHMETIC (resr, RDIV_EXPR, lr, rr); \
-	      ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
-	      FFEBAD; \
-	    }); \
-	 })
-#define ffetarget_eq_complex1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
-     li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
-     ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
-     *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
-       ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_eq_complex2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
-     li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
-     ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
-     *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
-       ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_eq_integer1(res,l,r) \
-  (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_eq_integer2(res,l,r) \
-  (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_eq_integer3(res,l,r) \
-  (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_eq_integer4(res,l,r) \
-  (*(res) = ((l) == (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_eq_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_eq_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     *(res) = REAL_VALUES_EQUAL (lr, rr) ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_eqv_integer1(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
-#define ffetarget_eqv_integer2(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
-#define ffetarget_eqv_integer3(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
-#define ffetarget_eqv_integer4(res,l,r) (*(res) = (l) ^ ~(r), FFEBAD)
-#define ffetarget_eqv_logical1(res,l,r) (*(res) = (l) == (r), FFEBAD)
-#define ffetarget_eqv_logical2(res,l,r) (*(res) = (l) == (r), FFEBAD)
-#define ffetarget_eqv_logical3(res,l,r) (*(res) = (l) == (r), FFEBAD)
-#define ffetarget_eqv_logical4(res,l,r) (*(res) = (l) == (r), FFEBAD)
-#define ffetarget_ge_integer1(res,l,r) \
-  (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ge_integer2(res,l,r) \
-  (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ge_integer3(res,l,r) \
-  (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ge_integer4(res,l,r) \
-  (*(res) = ((l) >= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ge_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_ge_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     *(res) = REAL_VALUES_LESS (lr, rr) ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_gt_integer1(res,l,r) \
-  (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_gt_integer2(res,l,r) \
-  (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_gt_integer3(res,l,r) \
-  (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_gt_integer4(res,l,r) \
-  (*(res) = ((l) > (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_gt_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
-       ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_gt_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
-       ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_hexxmil(v,t) ffetarget_typeless_hex (v, t)
-#define ffetarget_hexxvxt(v,t) ffetarget_typeless_hex (v, t)
-#define ffetarget_hexzmil(v,t) ffetarget_typeless_hex (v, t)
-#define ffetarget_hexzvxt(v,t) ffetarget_typeless_hex (v, t)
-#define ffetarget_init_0()
-#define ffetarget_init_1()
-#define ffetarget_init_2()
-#define ffetarget_init_3()
-#define ffetarget_init_4()
-#ifdef FFETARGET_32bit_longs
-#define ffetarget_integerdefault_is_magical(i) \
-  (((unsigned long int) i) == FFETARGET_integerBIG_MAGICAL)
-#else
-#define ffetarget_integerdefault_is_magical(i) \
-  (((unsigned int) i) == FFETARGET_integerBIG_MAGICAL)
-#endif
-#define ffetarget_iszero_real1(l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     REAL_VALUES_EQUAL (lr, dconst0); \
-   })
-#define ffetarget_iszero_real2(l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     REAL_VALUES_EQUAL (lr, dconst0); \
-   })
-#define ffetarget_iszero_typeless(l) ((l) == 0)
-#define ffetarget_logical1(v,truth) (*(v) = truth ? 1 : 0)
-#define ffetarget_le_integer1(res,l,r) \
-  (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_le_integer2(res,l,r) \
-  (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_le_integer3(res,l,r) \
-  (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_le_integer4(res,l,r) \
-  (*(res) = ((l) <= (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_le_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
-       ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_le_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     *(res) = (REAL_VALUES_LESS (lr, rr) || REAL_VALUES_EQUAL (lr, rr)) \
-       ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_lt_integer1(res,l,r) \
-  (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_lt_integer2(res,l,r) \
-  (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_lt_integer3(res,l,r) \
-  (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_lt_integer4(res,l,r) \
-  (*(res) = ((l) < (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_lt_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_lt_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     *(res) = REAL_VALUES_LESS (lr, rr) ? TRUE : FALSE; \
-     FFEBAD; })
-#define ffetarget_length_character1(c) ((c).length)
-#define ffetarget_length_characterdefault ffetarget_length_character1
-#define ffetarget_make_real1(res,lr) \
-  ffetarget_cvt_rv_to_r1_ ((lr), *(res))
-#define ffetarget_make_real2(res,lr) \
-  ffetarget_cvt_rv_to_r2_ ((lr), &((res)->v[0]))
-#define ffetarget_multiply_integer1(res,l,r) (*(res) = (l) * (r), FFEBAD)
-#define ffetarget_multiply_integer2(res,l,r) (*(res) = (l) * (r), FFEBAD)
-#define ffetarget_multiply_integer3(res,l,r) (*(res) = (l) * (r), FFEBAD)
-#define ffetarget_multiply_integer4(res,l,r) (*(res) = (l) * (r), FFEBAD)
-#define ffetarget_multiply_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
-     ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
-     FFEBAD; })
-#define ffetarget_multiply_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     REAL_ARITHMETIC (resr, MULT_EXPR, lr, rr); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
-     FFEBAD; })
-#define ffetarget_ne_complex1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
-     li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
-     ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
-     *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
-       ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_ne_complex2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
-     li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
-     ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
-     *(res) = (REAL_VALUES_EQUAL (lr, rr) && REAL_VALUES_EQUAL (li, ri)) \
-       ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_ne_integer1(res,l,r) \
-  (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ne_integer2(res,l,r) \
-  (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ne_integer3(res,l,r) \
-  (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ne_integer4(res,l,r) \
-  (*(res) = ((l) != (r)) ? TRUE : FALSE, FFEBAD)
-#define ffetarget_ne_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_ne_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     *(res) = REAL_VALUES_EQUAL (lr, rr) ? FALSE : TRUE; \
-     FFEBAD; })
-#define ffetarget_neqv_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_neqv_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_neqv_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_neqv_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_neqv_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_neqv_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_neqv_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_neqv_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_not_integer1(res,l) (*(res) = ~(l), FFEBAD)
-#define ffetarget_not_integer2(res,l) (*(res) = ~(l), FFEBAD)
-#define ffetarget_not_integer3(res,l) (*(res) = ~(l), FFEBAD)
-#define ffetarget_not_integer4(res,l) (*(res) = ~(l), FFEBAD)
-#define ffetarget_not_logical1(res,l) (*(res) = !(l), FFEBAD)
-#define ffetarget_not_logical2(res,l) (*(res) = !(l), FFEBAD)
-#define ffetarget_not_logical3(res,l) (*(res) = !(l), FFEBAD)
-#define ffetarget_not_logical4(res,l) (*(res) = !(l), FFEBAD)
-#define ffetarget_octalmil(v,t) ffetarget_typeless_octal (v, t)
-#define ffetarget_octalvxt(v,t) ffetarget_typeless_octal (v, t)
-#define ffetarget_offset(res,l) (*(res) = (l), TRUE)	/* Overflow? */
-#define ffetarget_offset_add(res,l,r) (*(res) = (l) + (r), TRUE)	/* Overflow? */
-#define ffetarget_offset_charsize(res,l,u) (*(res) = (l) * (u), TRUE)	/* Ov? */
-#define ffetarget_offset_multiply(res,l,r) (*(res) = (l) * (r), TRUE)	/* Ov? */
-#define ffetarget_offset_overflow(text) ((void) 0)	/* ~~no message? */
-#define ffetarget_or_integer1(res,l,r) (*(res) = (l) | (r), FFEBAD)
-#define ffetarget_or_integer2(res,l,r) (*(res) = (l) | (r), FFEBAD)
-#define ffetarget_or_integer3(res,l,r) (*(res) = (l) | (r), FFEBAD)
-#define ffetarget_or_integer4(res,l,r) (*(res) = (l) | (r), FFEBAD)
-#define ffetarget_or_logical1(res,l,r) (*(res) = (l) || (r), FFEBAD)
-#define ffetarget_or_logical2(res,l,r) (*(res) = (l) || (r), FFEBAD)
-#define ffetarget_or_logical3(res,l,r) (*(res) = (l) || (r), FFEBAD)
-#define ffetarget_or_logical4(res,l,r) (*(res) = (l) || (r), FFEBAD)
-#define ffetarget_print_binarymil(f,v) ffetarget_print_binary (f, v)
-#define ffetarget_print_binaryvxt(f,v) ffetarget_print_binary (f, v)
-#define ffetarget_print_hexxmil(f,v) ffetarget_print_hex (f, v)
-#define ffetarget_print_hexxvxt(f,v) ffetarget_print_hex (f, v)
-#define ffetarget_print_hexzmil(f,v) ffetarget_print_hex (f, v)
-#define ffetarget_print_hexzvxt(f,v) ffetarget_print_hex (f, v)
-#define ffetarget_print_integer1(f,v) \
-  fprintf ((f), "%" ffetargetInteger1_f "d", (v))
-#define ffetarget_print_integer2(f,v) \
-  fprintf ((f), "%" ffetargetInteger2_f "d", (v))
-#define ffetarget_print_integer3(f,v) \
-  fprintf ((f), "%" ffetargetInteger3_f "d", (v))
-#define ffetarget_print_integer4(f,v) \
-  fprintf ((f), "%" ffetargetInteger4_f "d", (v))
-#define ffetarget_print_logical1(f,v) \
-  fprintf ((f), "%" ffetargetLogical1_f "d", (v))
-#define ffetarget_print_logical2(f,v) \
-  fprintf ((f), "%" ffetargetLogical2_f "d", (v))
-#define ffetarget_print_logical3(f,v) \
-  fprintf ((f), "%" ffetargetLogical3_f "d", (v))
-#define ffetarget_print_logical4(f,v) \
-  fprintf ((f), "%" ffetargetLogical4_f "d", (v))
-#define ffetarget_print_octalmil(f,v) ffetarget_print_octal(f,v)
-#define ffetarget_print_octalvxt(f,v) ffetarget_print_octal(f,v)
-#define ffetarget_print_real1(f,l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     real_to_decimal (ffetarget_string_, &lr \
-			 sizeof(ffetarget_string_), 0, 1); \
-     fputs (ffetarget_string_, (f)); \
-   })
-#define ffetarget_print_real2(f,l) \
-  ({ REAL_VALUE_TYPE lr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     real_to_decimal (ffetarget_string_, &lr, \
-			 sizeof(ffetarget_string_), 0, 1); \
-     fputs (ffetarget_string_, (f)); \
-   })
-#define ffetarget_real1_one(res) ffetarget_cvt_rv_to_r1_ (dconst1, *(res))
-#define ffetarget_real2_one(res) ffetarget_cvt_rv_to_r2_ (dconst1, &((res)->v[0]))
-#define ffetarget_real1_two(res) ffetarget_cvt_rv_to_r1_ (dconst2, *(res))
-#define ffetarget_real2_two(res) ffetarget_cvt_rv_to_r2_ (dconst2, &((res)->v[0]))
-#define ffetarget_real1_zero(res) ffetarget_cvt_rv_to_r1_ (dconst0, *(res))
-#define ffetarget_real2_zero(res) ffetarget_cvt_rv_to_r2_ (dconst0, &((res)->v[0]))
-#define ffetarget_size_typeless_binary(t) ((ffetarget_num_digits_(t) + 7) / 8)
-#define ffetarget_size_typeless_octal(t) \
-  ((ffetarget_num_digits_(t) * 3 + 7) / 8)
-#define ffetarget_size_typeless_hex(t) ((ffetarget_num_digits_(t) + 1) / 2)
-#define ffetarget_subtract_complex1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
-     li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r).real); \
-     ri = ffetarget_cvt_r1_to_rv_ ((r).imaginary); \
-     REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
-     REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
-     ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
-     ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
-     FFEBAD; })
-#define ffetarget_subtract_complex2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, li, rr, ri, resr, resi; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
-     li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).real.v[0])); \
-     ri = ffetarget_cvt_r2_to_rv_ (&((r).imaginary.v[0])); \
-     REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
-     REAL_ARITHMETIC (resi, MINUS_EXPR, li, ri); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
-     ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
-     FFEBAD; })
-#define ffetarget_subtract_integer1(res,l,r) (*(res) = (l) - (r), FFEBAD)
-#define ffetarget_subtract_integer2(res,l,r) (*(res) = (l) - (r), FFEBAD)
-#define ffetarget_subtract_integer3(res,l,r) (*(res) = (l) - (r), FFEBAD)
-#define ffetarget_subtract_integer4(res,l,r) (*(res) = (l) - (r), FFEBAD)
-#define ffetarget_subtract_real1(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     rr = ffetarget_cvt_r1_to_rv_ ((r)); \
-     REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
-     ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
-     FFEBAD; })
-#define ffetarget_subtract_real2(res,l,r) \
-  ({ REAL_VALUE_TYPE lr, rr, resr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     rr = ffetarget_cvt_r2_to_rv_ (&((r).v[0])); \
-     REAL_ARITHMETIC (resr, MINUS_EXPR, lr, rr); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
-     FFEBAD; })
-#define ffetarget_terminate_0()
-#define ffetarget_terminate_1()
-#define ffetarget_terminate_2()
-#define ffetarget_terminate_3()
-#define ffetarget_terminate_4()
-#define ffetarget_text_character1(c) ((c).text)
-#define ffetarget_text_characterdefault ffetarget_text_character1
-#define ffetarget_uminus_complex1(res,l) \
-  ({ REAL_VALUE_TYPE lr, li, resr, resi; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l).real); \
-     li = ffetarget_cvt_r1_to_rv_ ((l).imaginary); \
-     resr = REAL_VALUE_NEGATE (lr); \
-     resi = REAL_VALUE_NEGATE (li); \
-     ffetarget_cvt_rv_to_r1_ (resr, (res)->real); \
-     ffetarget_cvt_rv_to_r1_ (resi, (res)->imaginary); \
-     FFEBAD; })
-#define ffetarget_uminus_complex2(res,l) \
-  ({ REAL_VALUE_TYPE lr, li, resr, resi; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).real.v[0])); \
-     li = ffetarget_cvt_r2_to_rv_ (&((l).imaginary.v[0])); \
-     resr = REAL_VALUE_NEGATE (lr); \
-     resi = REAL_VALUE_NEGATE (li); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->real.v[0])); \
-     ffetarget_cvt_rv_to_r2_ (resi, &((res)->imaginary.v[0])); \
-     FFEBAD; })
-#define ffetarget_uminus_integer1(res,l) (*(res) = -(l), FFEBAD)
-#define ffetarget_uminus_integer2(res,l) (*(res) = -(l), FFEBAD)
-#define ffetarget_uminus_integer3(res,l) (*(res) = -(l), FFEBAD)
-#define ffetarget_uminus_integer4(res,l) (*(res) = -(l), FFEBAD)
-#define ffetarget_uminus_real1(res,l) \
-  ({ REAL_VALUE_TYPE lr, resr; \
-     lr = ffetarget_cvt_r1_to_rv_ ((l)); \
-     resr = REAL_VALUE_NEGATE (lr); \
-     ffetarget_cvt_rv_to_r1_ (resr, *(res)); \
-     FFEBAD; })
-#define ffetarget_uminus_real2(res,l) \
-  ({ REAL_VALUE_TYPE lr, resr; \
-     lr = ffetarget_cvt_r2_to_rv_ (&((l).v[0])); \
-     resr = REAL_VALUE_NEGATE (lr); \
-     ffetarget_cvt_rv_to_r2_ (resr, &((res)->v[0])); \
-     FFEBAD; })
-#define ffetarget_value_real1(lr) ffetarget_cvt_r1_to_rv_ ((lr))
-#define ffetarget_value_real2(lr) ffetarget_cvt_r2_to_rv_ (&((lr).v[0]))
-#define ffetarget_xor_integer1(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_xor_integer2(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_xor_integer3(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_xor_integer4(res,l,r) (*(res) = (l) ^ (r), FFEBAD)
-#define ffetarget_xor_logical1(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_xor_logical2(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_xor_logical3(res,l,r) (*(res) = (l) != (r), FFEBAD)
-#define ffetarget_xor_logical4(res,l,r) (*(res) = (l) != (r), FFEBAD)
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_TARGET_H */
diff --git a/gcc/f/top.c b/gcc/f/top.c
deleted file mode 100644
index ce39dd0..0000000
--- a/gcc/f/top.c
+++ /dev/null
@@ -1,994 +0,0 @@
-/* top.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 1996, 1997, 1999, 2001, 2003
-   Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-      None.
-
-   Description:
-      The GNU Fortran Front End.
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "top.h"
-#include "bad.h"
-#include "bit.h"
-#include "bld.h"
-#include "com.h"
-#include "data.h"
-#include "equiv.h"
-#include "expr.h"
-#include "global.h"
-#include "implic.h"
-#include "info.h"
-#include "intrin.h"
-#include "lab.h"
-#include "lex.h"
-#include "malloc.h"
-#include "name.h"
-#include "options.h"
-#include "opts.h"
-#include "src.h"
-#include "st.h"
-#include "storag.h"
-#include "symbol.h"
-#include "target.h"
-#include "where.h"
-#include "flags.h"
-#include "toplev.h"
-
-/* Externals defined here. */
-
-bool ffe_is_do_internal_checks_ = FALSE;
-bool ffe_is_90_ = FFETARGET_defaultIS_90;
-bool ffe_is_automatic_ = FFETARGET_defaultIS_AUTOMATIC;
-bool ffe_is_backslash_ = FFETARGET_defaultIS_BACKSLASH;
-bool ffe_is_emulate_complex_ = FALSE;
-bool ffe_is_underscoring_ = FFETARGET_defaultEXTERNAL_UNDERSCORED
-  || FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
-bool ffe_is_second_underscore_ = FFETARGET_defaultUNDERSCORED_EXTERNAL_UNDERSCORED;
-bool ffe_is_debug_kludge_ = FALSE;
-bool ffe_is_dollar_ok_ = FFETARGET_defaultIS_DOLLAR_OK;
-bool ffe_is_f2c_ = FFETARGET_defaultIS_F2C;
-bool ffe_is_f2c_library_ = FFETARGET_defaultIS_F2C_LIBRARY;
-bool ffe_is_ffedebug_ = FALSE;
-bool ffe_is_flatten_arrays_ = FALSE;
-bool ffe_is_free_form_ = FFETARGET_defaultIS_FREE_FORM;
-bool ffe_is_globals_ = TRUE;
-bool ffe_is_init_local_zero_ = FFETARGET_defaultIS_INIT_LOCAL_ZERO;
-bool ffe_is_mainprog_;		/* TRUE if current prog unit known to be
-				   main. */
-bool ffe_is_onetrip_ = FALSE;
-bool ffe_is_silent_ = TRUE;
-bool ffe_is_typeless_boz_ = FALSE;
-bool ffe_is_pedantic_ = FFETARGET_defaultIS_PEDANTIC;
-bool ffe_is_saveall_;		/* TRUE if mainprog or SAVE (no args) seen. */
-bool ffe_is_ugly_args_ = TRUE;
-bool ffe_is_ugly_assign_ = FALSE;	/* Try and store pointer to ASSIGN labels in INTEGER vars. */
-bool ffe_is_ugly_assumed_ = FALSE;	/* DIMENSION X([...,]1) => DIMENSION X([...,]*) */
-bool ffe_is_ugly_comma_ = FALSE;
-bool ffe_is_ugly_complex_ = FALSE;
-bool ffe_is_ugly_init_ = TRUE;
-bool ffe_is_ugly_logint_ = FALSE;
-bool ffe_is_version_ = FALSE;
-bool ffe_is_vxt_ = FALSE;
-bool ffe_is_warn_globals_ = TRUE;
-bool ffe_is_warn_implicit_ = FALSE;
-bool ffe_is_warn_surprising_ = FALSE;
-bool ffe_is_zeros_ = FALSE;
-ffeCase ffe_case_intrin_ = FFETARGET_defaultCASE_INTRIN;
-ffeCase ffe_case_match_ = FFETARGET_defaultCASE_MATCH;
-ffeCase ffe_case_source_ = FFETARGET_defaultCASE_SOURCE;
-ffeCase ffe_case_symbol_ = FFETARGET_defaultCASE_SYMBOL;
-ffeIntrinsicState ffe_intrinsic_state_badu77_ = FFE_intrinsicstateENABLED;
-ffeIntrinsicState ffe_intrinsic_state_gnu_ = FFE_intrinsicstateENABLED;
-ffeIntrinsicState ffe_intrinsic_state_f2c_ = FFE_intrinsicstateENABLED;
-ffeIntrinsicState ffe_intrinsic_state_f90_ = FFE_intrinsicstateENABLED;
-ffeIntrinsicState ffe_intrinsic_state_mil_ = FFE_intrinsicstateENABLED;
-ffeIntrinsicState ffe_intrinsic_state_unix_ = FFE_intrinsicstateENABLED;
-ffeIntrinsicState ffe_intrinsic_state_vxt_ = FFE_intrinsicstateENABLED;
-int ffe_fixed_line_length_ = FFETARGET_defaultFIXED_LINE_LENGTH;
-mallocPool ffe_file_pool_ = NULL;
-mallocPool ffe_any_unit_pool_ = NULL;
-mallocPool ffe_program_unit_pool_ = NULL;
-ffeCounter ffe_count_0 = 0;
-ffeCounter ffe_count_1 = 0;
-ffeCounter ffe_count_2 = 0;
-ffeCounter ffe_count_3 = 0;
-ffeCounter ffe_count_4 = 0;
-bool ffe_in_0 = FALSE;
-bool ffe_in_1 = FALSE;
-bool ffe_in_2 = FALSE;
-bool ffe_in_3 = FALSE;
-bool ffe_in_4 = FALSE;
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-
-/* Static objects accessed by functions in this module. */
-
-
-/* Static functions (internal). */
-
-static bool ffe_is_digit_string_ (const char *s);
-
-/* Internal macros. */
-
-static bool
-ffe_is_digit_string_ (const char *s)
-{
-  const char *p;
-
-  for (p = s; ISDIGIT (*p); ++p)
-    ;
-
-  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_handle_option (size_t scode, const char *arg, int value)
-{
-  enum opt_code code = (enum opt_code) scode;
-
-  switch (code)
-    {
-    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);
-      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;
-      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)
-	{
-	  if (warn_uninitialized != 1)
-	    warn_uninitialized = 2;
-	}
-      else
-	warn_uninitialized = 0;
-      break;
-
-    case OPT_I:
-      ffecom_decode_include_option (arg);
-      break;
-    }
-
-  return 1;
-}
-
-/* Run the FFE on a source file (not an INCLUDEd file).
-
-   Runs the whole shebang.
-
-   Prepare and invoke the appropriate lexer.  */
-
-void
-ffe_file (ffewhereFile wf, FILE *f)
-{
-  ffe_init_1 ();
-  ffelex_set_handler ((ffelexHandler) ffest_first);
-  ffewhere_file_set (wf, TRUE, 0);
-  if (ffe_is_free_form_)
-    ffelex_file_free (wf, f);
-  else
-    ffelex_file_fixed (wf, f);
-  ffest_eof ();
-  ffe_terminate_1 ();
-}
-
-/* ffe_init_0 -- Initialize the FFE per image invocation
-
-   ffe_init_0();
-
-   Performs per-image invocation.  */
-
-void
-ffe_init_0 (void)
-{
-  ++ffe_count_0;
-  ffe_in_0 = TRUE;
-
-  ffebad_init_0 ();
-  ffebit_init_0 ();
-  ffebld_init_0 ();
-  ffecom_init_0 ();
-  ffedata_init_0 ();
-  ffeequiv_init_0 ();
-  ffeexpr_init_0 ();
-  ffeglobal_init_0 ();
-  ffeimplic_init_0 ();
-  ffeinfo_init_0 ();
-  ffeintrin_init_0 ();
-  ffelab_init_0 ();
-  ffelex_init_0 ();
-  ffename_init_0 ();
-  ffesrc_init_0 ();
-  ffest_init_0 ();
-  ffestorag_init_0 ();
-  ffesymbol_init_0 ();
-  ffetarget_init_0 ();
-  ffetype_init_0 ();
-  ffewhere_init_0 ();
-}
-
-/* ffe_init_1 -- Initialize the FFE per source file
-
-   ffe_init_1();
-
-   Performs per-source-file invocation (not including INCLUDEd files).	*/
-
-void
-ffe_init_1 (void)
-{
-  ++ffe_count_1;
-  ffe_in_1 = TRUE;
-
-  assert (ffe_file_pool_ == NULL);
-  ffe_file_pool_ = malloc_pool_new ("File", malloc_pool_image (), 1024);
-
-  ffebad_init_1 ();
-  ffebit_init_1 ();
-  ffebld_init_1 ();
-  ffecom_init_1 ();
-  ffedata_init_1 ();
-  ffeequiv_init_1 ();
-  ffeexpr_init_1 ();
-  ffeglobal_init_1 ();
-  ffeimplic_init_1 ();
-  ffeinfo_init_1 ();
-  ffeintrin_init_1 ();
-  ffelab_init_1 ();
-  ffelex_init_1 ();
-  ffename_init_1 ();
-  ffesrc_init_1 ();
-  ffest_init_1 ();
-  ffestorag_init_1 ();
-  ffesymbol_init_1 ();
-  ffetarget_init_1 ();
-  ffetype_init_1 ();
-  ffewhere_init_1 ();
-
-  ffe_init_2 ();
-}
-
-/* ffe_init_2 -- Initialize the FFE per outer program unit
-
-   ffe_init_2();
-
-   Performs per-program-unit invocation.  */
-
-void
-ffe_init_2 (void)
-{
-  ++ffe_count_2;
-  ffe_in_2 = TRUE;
-
-  assert (ffe_program_unit_pool_ == NULL);
-  ffe_program_unit_pool_ = malloc_pool_new ("Program unit", ffe_file_pool_, 1024);
-  ffe_is_mainprog_ = FALSE;
-  ffe_is_saveall_ = !ffe_is_automatic_;
-
-  ffebad_init_2 ();
-  ffebit_init_2 ();
-  ffebld_init_2 ();
-  ffecom_init_2 ();
-  ffedata_init_2 ();
-  ffeequiv_init_2 ();
-  ffeexpr_init_2 ();
-  ffeglobal_init_2 ();
-  ffeimplic_init_2 ();
-  ffeinfo_init_2 ();
-  ffeintrin_init_2 ();
-  ffelab_init_2 ();
-  ffelex_init_2 ();
-  ffename_init_2 ();
-  ffesrc_init_2 ();
-  ffest_init_2 ();
-  ffestorag_init_2 ();
-  ffesymbol_init_2 ();
-  ffetarget_init_2 ();
-  ffetype_init_2 ();
-  ffewhere_init_2 ();
-
-  ffe_init_3 ();
-}
-
-/* ffe_init_3 -- Initialize the FFE per any program unit
-
-   ffe_init_3();
-
-   Performs per-any-unit initialization; does NOT do
-   per-statement-function-definition initialization (i.e. the chain
-   of inits, from 0-3, breaks here; level 4 must be invoked independently).  */
-
-void
-ffe_init_3 (void)
-{
-  ++ffe_count_3;
-  ffe_in_3 = TRUE;
-
-  assert (ffe_any_unit_pool_ == NULL);
-  ffe_any_unit_pool_ = malloc_pool_new ("Any unit", ffe_program_unit_pool_, 1024);
-
-  ffebad_init_3 ();
-  ffebit_init_3 ();
-  ffebld_init_3 ();
-  ffecom_init_3 ();
-  ffedata_init_3 ();
-  ffeequiv_init_3 ();
-  ffeexpr_init_3 ();
-  ffeglobal_init_3 ();
-  ffeimplic_init_3 ();
-  ffeinfo_init_3 ();
-  ffeintrin_init_3 ();
-  ffelab_init_3 ();
-  ffelex_init_3 ();
-  ffename_init_3 ();
-  ffesrc_init_3 ();
-  ffest_init_3 ();
-  ffestorag_init_3 ();
-  ffesymbol_init_3 ();
-  ffetarget_init_3 ();
-  ffetype_init_3 ();
-  ffewhere_init_3 ();
-}
-
-/* ffe_init_4 -- Initialize the FFE per statement function definition
-
-   ffe_init_4();  */
-
-void
-ffe_init_4 (void)
-{
-  ++ffe_count_4;
-  ffe_in_4 = TRUE;
-
-  ffebad_init_4 ();
-  ffebit_init_4 ();
-  ffebld_init_4 ();
-  ffecom_init_4 ();
-  ffedata_init_4 ();
-  ffeequiv_init_4 ();
-  ffeexpr_init_4 ();
-  ffeglobal_init_4 ();
-  ffeimplic_init_4 ();
-  ffeinfo_init_4 ();
-  ffeintrin_init_4 ();
-  ffelab_init_4 ();
-  ffelex_init_4 ();
-  ffename_init_4 ();
-  ffesrc_init_4 ();
-  ffest_init_4 ();
-  ffestorag_init_4 ();
-  ffesymbol_init_4 ();
-  ffetarget_init_4 ();
-  ffetype_init_4 ();
-  ffewhere_init_4 ();
-}
-
-/* ffe_terminate_0 -- Terminate the FFE prior to image termination
-
-   ffe_terminate_0();  */
-
-void
-ffe_terminate_0 (void)
-{
-  ffe_count_1 = 0;
-  ffe_in_0 = FALSE;
-
-  ffebad_terminate_0 ();
-  ffebit_terminate_0 ();
-  ffebld_terminate_0 ();
-  ffecom_terminate_0 ();
-  ffedata_terminate_0 ();
-  ffeequiv_terminate_0 ();
-  ffeexpr_terminate_0 ();
-  ffeglobal_terminate_0 ();
-  ffeimplic_terminate_0 ();
-  ffeinfo_terminate_0 ();
-  ffeintrin_terminate_0 ();
-  ffelab_terminate_0 ();
-  ffelex_terminate_0 ();
-  ffename_terminate_0 ();
-  ffesrc_terminate_0 ();
-  ffest_terminate_0 ();
-  ffestorag_terminate_0 ();
-  ffesymbol_terminate_0 ();
-  ffetarget_terminate_0 ();
-  ffetype_terminate_0 ();
-  ffewhere_terminate_0 ();
-}
-
-/* ffe_terminate_1 -- Terminate the FFE after seeing source file EOF
-
-   ffe_terminate_1();  */
-
-void
-ffe_terminate_1 (void)
-{
-  ffe_count_2 = 0;
-  ffe_in_1 = FALSE;
-
-  ffe_terminate_2 ();
-
-  ffebad_terminate_1 ();
-  ffebit_terminate_1 ();
-  ffebld_terminate_1 ();
-  ffecom_terminate_1 ();
-  ffedata_terminate_1 ();
-  ffeequiv_terminate_1 ();
-  ffeexpr_terminate_1 ();
-  ffeglobal_terminate_1 ();
-  ffeimplic_terminate_1 ();
-  ffeinfo_terminate_1 ();
-  ffeintrin_terminate_1 ();
-  ffelab_terminate_1 ();
-  ffelex_terminate_1 ();
-  ffename_terminate_1 ();
-  ffesrc_terminate_1 ();
-  ffest_terminate_1 ();
-  ffestorag_terminate_1 ();
-  ffesymbol_terminate_1 ();
-  ffetarget_terminate_1 ();
-  ffetype_terminate_1 ();
-  ffewhere_terminate_1 ();
-
-  assert (ffe_file_pool_ != NULL);
-  malloc_pool_kill (ffe_file_pool_);
-  ffe_file_pool_ = NULL;
-}
-
-/* ffe_terminate_2 -- Terminate the FFE after seeing outer program unit END
-
-   ffe_terminate_2();  */
-
-void
-ffe_terminate_2 (void)
-{
-  ffe_count_3 = 0;
-  ffe_in_2 = FALSE;
-
-  ffe_terminate_3 ();
-
-  ffebad_terminate_2 ();
-  ffebit_terminate_2 ();
-  ffebld_terminate_2 ();
-  ffecom_terminate_2 ();
-  ffedata_terminate_2 ();
-  ffeequiv_terminate_2 ();
-  ffeexpr_terminate_2 ();
-  ffeglobal_terminate_2 ();
-  ffeimplic_terminate_2 ();
-  ffeinfo_terminate_2 ();
-  ffeintrin_terminate_2 ();
-  ffelab_terminate_2 ();
-  ffelex_terminate_2 ();
-  ffename_terminate_2 ();
-  ffesrc_terminate_2 ();
-  ffest_terminate_2 ();
-  ffestorag_terminate_2 ();
-  ffesymbol_terminate_2 ();
-  ffetarget_terminate_2 ();
-  ffetype_terminate_2 ();
-  ffewhere_terminate_2 ();
-
-  assert (ffe_program_unit_pool_ != NULL);
-  malloc_pool_kill (ffe_program_unit_pool_);
-  ffe_program_unit_pool_ = NULL;
-}
-
-/* ffe_terminate_3 -- Terminate the FFE after seeing any program unit END
-
-   ffe_terminate_3();  */
-
-void
-ffe_terminate_3 (void)
-{
-  ffe_count_4 = 0;
-  ffe_in_3 = FALSE;
-
-  ffebad_terminate_3 ();
-  ffebit_terminate_3 ();
-  ffebld_terminate_3 ();
-  ffecom_terminate_3 ();
-  ffedata_terminate_3 ();
-  ffeequiv_terminate_3 ();
-  ffeexpr_terminate_3 ();
-  ffeglobal_terminate_3 ();
-  ffeimplic_terminate_3 ();
-  ffeinfo_terminate_3 ();
-  ffeintrin_terminate_3 ();
-  ffelab_terminate_3 ();
-  ffelex_terminate_3 ();
-  ffename_terminate_3 ();
-  ffesrc_terminate_3 ();
-  ffest_terminate_3 ();
-  ffestorag_terminate_3 ();
-  ffesymbol_terminate_3 ();
-  ffetarget_terminate_3 ();
-  ffetype_terminate_3 ();
-  ffewhere_terminate_3 ();
-
-  assert (ffe_any_unit_pool_ != NULL);
-  malloc_pool_kill (ffe_any_unit_pool_);
-  ffe_any_unit_pool_ = NULL;
-}
-
-/* ffe_terminate_4 -- Terminate the FFE after seeing sfunc def expression
-
-   ffe_terminate_4();  */
-
-void
-ffe_terminate_4 (void)
-{
-  ffe_in_4 = FALSE;
-
-  ffebad_terminate_4 ();
-  ffebit_terminate_4 ();
-  ffebld_terminate_4 ();
-  ffecom_terminate_4 ();
-  ffedata_terminate_4 ();
-  ffeequiv_terminate_4 ();
-  ffeexpr_terminate_4 ();
-  ffeglobal_terminate_4 ();
-  ffeimplic_terminate_4 ();
-  ffeinfo_terminate_4 ();
-  ffeintrin_terminate_4 ();
-  ffelab_terminate_4 ();
-  ffelex_terminate_4 ();
-  ffename_terminate_4 ();
-  ffesrc_terminate_4 ();
-  ffest_terminate_4 ();
-  ffestorag_terminate_4 ();
-  ffesymbol_terminate_4 ();
-  ffetarget_terminate_4 ();
-  ffetype_terminate_4 ();
-  ffewhere_terminate_4 ();
-}
diff --git a/gcc/f/top.h b/gcc/f/top.h
deleted file mode 100644
index 5538ab8..0000000
--- a/gcc/f/top.h
+++ /dev/null
@@ -1,262 +0,0 @@
-/* top.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 1996, 1997, 1999 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      top.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_TOP_H
-#define GCC_F_TOP_H
-
-/* Simple definitions and enumerations. */
-
-enum _ffe_case_
-  {
-    FFE_caseNONE,		/* No case conversion, match
-				   case-insensitive. */
-    FFE_caseUPPER,		/* Convert lowercase to uppercase, match
-				   upper. */
-    FFE_caseLOWER,		/* Convert uppercase to lowercase, match
-				   lower. */
-    FFE_caseINITCAP,		/* Match InitialCap (no meaning for
-				   conversion). */
-    FFE_case
-  };
-typedef enum _ffe_case_ ffeCase;
-
-enum _ffeintrinsic_state_
-  {				/* State of a family of intrinsics. NOTE:
-				   order IS important, see
-				   ffe_intrinsic_state_max (). */
-    FFE_intrinsicstateDELETED,	/* Doesn't exist at all. */
-    FFE_intrinsicstateDISABLED,	/* Diagnostic if used as intrinsic. */
-    FFE_intrinsicstateHIDDEN,	/* Exists only if INTRINSIC stmt. */
-    FFE_intrinsicstateENABLED,	/* Exists as normal. */
-    FFE_intrinsicstate
-  };
-typedef enum _ffeintrinsic_state_ ffeIntrinsicState;
-
-/* Typedefs. */
-
-typedef unsigned long ffeCounter;
-#define ffeCounter_f "l"
-typedef unsigned int ffeKwIndex;
-typedef unsigned long int ffeTokenLength;
-#define ffeTokenLength_f "l"
-typedef void *ffeUnionLongPtr;	/* unused type to cover union of long and
-				   ptr. */
-
-/* Include files needed by this one. */
-
-#include "malloc.h"
-#include "where.h"
-
-/* Structure definitions. */
-
-
-/* Global objects accessed by users of this module. */
-
-extern bool ffe_is_do_internal_checks_;
-extern bool ffe_is_90_;
-extern bool ffe_is_automatic_;
-extern bool ffe_is_backslash_;
-extern bool ffe_is_emulate_complex_;
-extern bool ffe_is_underscoring_;
-extern bool ffe_is_second_underscore_;
-extern bool ffe_is_debug_kludge_;
-extern bool ffe_is_dollar_ok_;
-extern bool ffe_is_f2c_;
-extern bool ffe_is_f2c_library_;
-extern bool ffe_is_ffedebug_;
-extern bool ffe_is_flatten_arrays_;
-extern bool ffe_is_free_form_;
-extern bool ffe_is_globals_;
-extern bool ffe_is_init_local_zero_;
-extern bool ffe_is_mainprog_;
-extern bool ffe_is_onetrip_;
-extern bool ffe_is_silent_;
-extern bool ffe_is_typeless_boz_;
-extern bool ffe_is_pedantic_;
-extern bool ffe_is_saveall_;
-extern bool ffe_is_ugly_args_;
-extern bool ffe_is_ugly_assign_;
-extern bool ffe_is_ugly_assumed_;
-extern bool ffe_is_ugly_comma_;
-extern bool ffe_is_ugly_complex_;
-extern bool ffe_is_ugly_init_;
-extern bool ffe_is_ugly_logint_;
-extern bool ffe_is_version_;
-extern bool ffe_is_vxt_;
-extern bool ffe_is_warn_globals_;
-extern bool ffe_is_warn_implicit_;
-extern bool ffe_is_warn_surprising_;
-extern bool ffe_is_zeros_;
-extern ffeCase ffe_case_intrin_;
-extern ffeCase ffe_case_match_;
-extern ffeCase ffe_case_source_;
-extern ffeCase ffe_case_symbol_;
-extern ffeIntrinsicState ffe_intrinsic_state_badu77_;
-extern ffeIntrinsicState ffe_intrinsic_state_gnu_;
-extern ffeIntrinsicState ffe_intrinsic_state_f2c_;
-extern ffeIntrinsicState ffe_intrinsic_state_f90_;
-extern ffeIntrinsicState ffe_intrinsic_state_mil_;
-extern ffeIntrinsicState ffe_intrinsic_state_unix_;
-extern ffeIntrinsicState ffe_intrinsic_state_vxt_;
-extern int ffe_fixed_line_length_;
-extern mallocPool ffe_file_pool_;
-extern mallocPool ffe_any_unit_pool_;
-extern mallocPool ffe_program_unit_pool_;
-extern ffeCounter ffe_count_0;
-extern ffeCounter ffe_count_1;
-extern ffeCounter ffe_count_2;
-extern ffeCounter ffe_count_3;
-extern ffeCounter ffe_count_4;
-extern bool ffe_in_0;
-extern bool ffe_in_1;
-extern bool ffe_in_2;
-extern bool ffe_in_3;
-extern bool ffe_in_4;
-
-/* Declare functions with prototypes. */
-
-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);
-void ffe_init_2 (void);
-void ffe_init_3 (void);
-void ffe_init_4 (void);
-void ffe_terminate_0 (void);
-void ffe_terminate_1 (void);
-void ffe_terminate_2 (void);
-void ffe_terminate_3 (void);
-void ffe_terminate_4 (void);
-
-/* Define macros. */
-
-#define ffe_case_intrin() ffe_case_intrin_
-#define ffe_case_match() ffe_case_match_
-#define ffe_case_source() ffe_case_source_
-#define ffe_case_symbol() ffe_case_symbol_
-#define ffe_intrinsic_state_badu77() ffe_intrinsic_state_badu77_
-#define ffe_intrinsic_state_f2c() ffe_intrinsic_state_f2c_
-#define ffe_intrinsic_state_f90() ffe_intrinsic_state_f90_
-#define ffe_intrinsic_state_gnu() ffe_intrinsic_state_gnu_
-#define ffe_intrinsic_state_mil() ffe_intrinsic_state_mil_
-#define ffe_intrinsic_state_unix() ffe_intrinsic_state_unix_
-#define ffe_intrinsic_state_vxt() ffe_intrinsic_state_vxt_
-#define ffe_is_90() ffe_is_90_
-#define ffe_is_automatic() ffe_is_automatic_
-#define ffe_is_backslash() ffe_is_backslash_
-#define ffe_is_debug_kludge() ffe_is_debug_kludge_
-#define ffe_is_do_internal_checks() ffe_is_do_internal_checks_
-#define ffe_is_dollar_ok() ffe_is_dollar_ok_
-#define ffe_is_emulate_complex() ffe_is_emulate_complex_
-#define ffe_is_f2c() ffe_is_f2c_
-#define ffe_is_f2c_library() ffe_is_f2c_library_
-#define ffe_is_ffedebug() ffe_is_ffedebug_
-#define ffe_is_flatten_arrays() ffe_is_flatten_arrays_
-#define ffe_is_free_form() ffe_is_free_form_
-#define ffe_is_globals() ffe_is_globals_
-#define ffe_is_init_local_zero() ffe_is_init_local_zero_
-#define ffe_is_mainprog() ffe_is_mainprog_
-#define ffe_is_onetrip() ffe_is_onetrip_
-#define ffe_is_pedantic() ffe_is_pedantic_
-#define ffe_is_pedantic_not_90() (ffe_is_pedantic_ && !ffe_is_90_)
-#define ffe_is_saveall() ffe_is_saveall_
-#define ffe_is_second_underscore() ffe_is_second_underscore_
-#define ffe_is_silent() ffe_is_silent_
-#define ffe_is_typeless_boz() ffe_is_typeless_boz_
-#define ffe_is_ugly_args() ffe_is_ugly_args_
-#define ffe_is_ugly_assign() ffe_is_ugly_assign_
-#define ffe_is_ugly_assumed() ffe_is_ugly_assumed_
-#define ffe_is_ugly_comma() ffe_is_ugly_comma_
-#define ffe_is_ugly_complex() ffe_is_ugly_complex_
-#define ffe_is_ugly_init() ffe_is_ugly_init_
-#define ffe_is_ugly_logint() ffe_is_ugly_logint_
-#define ffe_is_underscoring() ffe_is_underscoring_
-#define ffe_is_version() ffe_is_version_
-#define ffe_is_vxt() ffe_is_vxt_
-#define ffe_is_warn_globals() ffe_is_warn_globals_
-#define ffe_is_warn_implicit() ffe_is_warn_implicit_
-#define ffe_is_warn_surprising() ffe_is_warn_surprising_
-#define ffe_is_zeros() ffe_is_zeros_
-#define ffe_fixed_line_length() ffe_fixed_line_length_
-#define ffe_pool_file() (ffe_file_pool_)
-#define ffe_pool_any_unit() (ffe_any_unit_pool_)
-#define ffe_pool_program_unit() (ffe_program_unit_pool_)
-#define ffe_set_case_intrin(f) (ffe_case_intrin_ = (f))
-#define ffe_set_case_match(f) (ffe_case_match_ = (f))
-#define ffe_set_case_source(f) (ffe_case_source_ = (f))
-#define ffe_set_case_symbol(f) (ffe_case_symbol_ = (f))
-#define ffe_set_intrinsic_state_badu77(s) (ffe_intrinsic_state_badu77_ = (s))
-#define ffe_set_intrinsic_state_f2c(s) (ffe_intrinsic_state_f2c_ = (s))
-#define ffe_set_intrinsic_state_f90(s) (ffe_intrinsic_state_f90_ = (s))
-#define ffe_set_intrinsic_state_gnu(s) (ffe_intrinsic_state_gnu_ = (s))
-#define ffe_set_intrinsic_state_mil(s) (ffe_intrinsic_state_mil_ = (s))
-#define ffe_set_intrinsic_state_unix(s) (ffe_intrinsic_state_unix_ = (s))
-#define ffe_set_intrinsic_state_vxt(s) (ffe_intrinsic_state_vxt_ = (s))
-#define ffe_set_is_90(f) (ffe_is_90_ = (f))
-#define ffe_set_is_automatic(f) (ffe_is_automatic_ = (f))
-#define ffe_set_is_backslash(f) (ffe_is_backslash_ = (f))
-#define ffe_set_is_debug_kludge(f) (ffe_is_debug_kludge_ = (f))
-#define ffe_set_is_do_internal_checks(f) (ffe_is_do_internal_checks_ = (f))
-#define ffe_set_is_dollar_ok(f) (ffe_is_dollar_ok_ = (f))
-#define ffe_set_is_emulate_complex(f) (ffe_is_emulate_complex_ = (f))
-#define ffe_set_is_f2c(f) (ffe_is_f2c_ = (f))
-#define ffe_set_is_f2c_library(f) (ffe_is_f2c_library_ = (f))
-#define ffe_set_is_ffedebug(f) (ffe_is_ffedebug_ = (f))
-#define ffe_set_is_flatten_arrays(f) (ffe_is_flatten_arrays_ = (f))
-#define ffe_set_is_free_form(f) (ffe_is_free_form_ = (f))
-#define ffe_set_is_globals(f) (ffe_is_globals_ = (f))
-#define ffe_set_is_init_local_zero(f) (ffe_is_init_local_zero_ = (f))
-#define ffe_set_is_mainprog(f) (ffe_is_mainprog_ = (f))
-#define ffe_set_is_onetrip(f) (ffe_is_onetrip_ = (f))
-#define ffe_set_is_pedantic(f) (ffe_is_pedantic_ = (f))
-#define ffe_set_is_saveall(f) (ffe_is_saveall_ = (f))
-#define ffe_set_is_second_underscore(f) (ffe_is_second_underscore_ = (f))
-#define ffe_set_is_silent(f) (ffe_is_silent_ = (f))
-#define ffe_set_is_typeless_boz(f) (ffe_is_typeless_boz_ = (f))
-#define ffe_set_is_ugly_args(f) (ffe_is_ugly_args_ = (f))
-#define ffe_set_is_ugly_assign(f) (ffe_is_ugly_assign_ = (f))
-#define ffe_set_is_ugly_assumed(f) (ffe_is_ugly_assumed_ = (f))
-#define ffe_set_is_ugly_comma(f) (ffe_is_ugly_comma_ = (f))
-#define ffe_set_is_ugly_complex(f) (ffe_is_ugly_complex_ = (f))
-#define ffe_set_is_ugly_init(f) (ffe_is_ugly_init_ = (f))
-#define ffe_set_is_ugly_logint(f) (ffe_is_ugly_logint_ = (f))
-#define ffe_set_is_underscoring(f) (ffe_is_underscoring_ = (f))
-#define ffe_set_is_version(f) (ffe_is_version_ = (f))
-#define ffe_set_is_vxt(f) (ffe_is_vxt_ = (f))
-#define ffe_set_is_warn_globals(f) (ffe_is_warn_globals_ = (f))
-#define ffe_set_is_warn_implicit(f) (ffe_is_warn_implicit_ = (f))
-#define ffe_set_is_warn_surprising(f) (ffe_is_warn_surprising_ = (f))
-#define ffe_set_is_zeros(f) (ffe_is_zeros_ = (f))
-#define ffe_set_fixed_line_length(l) (ffe_fixed_line_length_ = (l))
-#define ffe_state_max(s1,s2) ((s1) > (s2) ? (s1) : (s2))
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_TOP_H */
diff --git a/gcc/f/type.c b/gcc/f/type.c
deleted file mode 100644
index d25ab50..0000000
--- a/gcc/f/type.c
+++ /dev/null
@@ -1,104 +0,0 @@
-/* Implementation of Fortran type abstraction
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 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 "proj.h"
-#include "type.h"
-#include "malloc.h"
-
-
-/* Look up a type given its base type and kind value.  */
-
-ffetype
-ffetype_lookup_kind (ffetype base_type, int kind)
-{
-  if ((base_type->kinds_ == NULL)
-      || (kind < 0)
-      || (((size_t) kind) >= ARRAY_SIZE (base_type->kinds_->type_)))
-    return NULL;
-
-  return base_type->kinds_->type_[kind];
-}
-
-ffetype
-ffetype_lookup_star (ffetype base_type, int star)
-{
-  if ((base_type->stars_ == NULL)
-      || (star < 0)
-      || (((size_t) star) >= ARRAY_SIZE (base_type->stars_->type_)))
-    return NULL;
-
-  return base_type->stars_->type_[star];
-}
-
-ffetype
-ffetype_new (void)
-{
-  ffetype type;
-
-  type = malloc_new_kp (malloc_pool_image (), "ffetype", sizeof (*type));
-  type->kinds_ = NULL;
-  type->stars_ = NULL;
-  type->alignment_ = 0;
-  type->modulo_ = 0;
-  type->size_ = 0;
-
-  return type;
-}
-
-void
-ffetype_set_kind (ffetype base_type, int kind, ffetype type)
-{
-  assert (kind < (int) sizeof (*(base_type->kinds_)));
-
-  if (base_type->kinds_ == NULL)
-    {
-      int i;
-
-      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;
-    }
-
-  assert (base_type->kinds_->type_[kind] == NULL);
-
-  base_type->kinds_->type_[kind] = type;
-}
-
-void
-ffetype_set_star (ffetype base_type, int star, ffetype type)
-{
-  if (base_type->stars_ == NULL)
-    {
-      int i;
-
-      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;
-    }
-
-  assert (base_type->stars_->type_[star] == NULL);
-
-  base_type->stars_->type_[star] = type;
-}
diff --git a/gcc/f/type.h b/gcc/f/type.h
deleted file mode 100644
index 9e3bd80..0000000
--- a/gcc/f/type.h
+++ /dev/null
@@ -1,64 +0,0 @@
-/* Interface definitions for Fortran type abstraction
-   Copyright (C) 1995 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.  */
-
-#ifndef GCC_F_TYPE_H
-#define GCC_F_TYPE_H
-
-typedef struct _ffetype_ *ffetype;
-typedef struct _ffetype_indexes_ *ffetype_indexes_;
-
-struct _ffetype_
-  {
-    ffetype_indexes_ kinds_;
-    ffetype_indexes_ stars_;
-    int alignment_;
-    int modulo_;
-    int size_;
-  };
-
-struct _ffetype_indexes_
-  {
-    ffetype type_[40];	/* *n, KIND=n: 0 <= n <= 39. */
-  };
-
-#define ffetype_alignment(t) ((t)->alignment_)
-#define ffetype_init_0()
-#define ffetype_init_1()
-#define ffetype_init_2()
-#define ffetype_init_3()
-#define ffetype_init_4()
-ffetype ffetype_lookup_kind (ffetype base_type, int kind);
-ffetype ffetype_lookup_star (ffetype base_type, int star);
-#define ffetype_modulo(t) ((t)->modulo_)
-ffetype ffetype_new (void);
-#define ffetype_set_ams(t,a,m,s) ((t)->alignment_ = (a), \
-				  (t)->modulo_ = (m), \
-				  (t)->size_ = (s))
-void ffetype_set_kind (ffetype base_type, int kind, ffetype type);
-void ffetype_set_star (ffetype base_type, int star, ffetype type);
-#define ffetype_size(t) ((t)->size_)
-#define ffetype_terminate_0()
-#define ffetype_terminate_1()
-#define ffetype_terminate_2()
-#define ffetype_terminate_3()
-#define ffetype_terminate_4()
-
-#endif /* ! GCC_F_TYPE_H */
diff --git a/gcc/f/where.c b/gcc/f/where.c
deleted file mode 100644
index b409a46..0000000
--- a/gcc/f/where.c
+++ /dev/null
@@ -1,520 +0,0 @@
-/* where.c -- Implementation File (module.c template V1.0)
-   Copyright (C) 1995, 2002, 2003 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Related Modules:
-
-   Description:
-      Simple data abstraction for Fortran source lines (called card images).
-
-   Modifications:
-*/
-
-/* Include files. */
-
-#include "proj.h"
-#include "where.h"
-#include "lex.h"
-#include "malloc.h"
-#include "ggc.h"
-
-/* Externals defined here. */
-
-struct _ffewhere_line_ ffewhere_unknown_line_
-=
-{NULL, NULL, 0, 0, 0, {0}};
-
-/* Simple definitions and enumerations. */
-
-
-/* Internal typedefs. */
-
-typedef struct _ffewhere_ll_ *ffewhereLL_;
-
-/* Private include files. */
-
-
-/* Internal structure definitions. */
-
-struct _ffewhere_ll_ GTY (())
-  {
-    ffewhereLL_ next;
-    ffewhereLL_ previous;
-    ffewhereFile wf;
-    ffewhereLineNumber line_no;	/* ffelex_line_number() at time of creation. */
-    ffewhereLineNumber offset;	/* User-desired offset (usually 1). */
-  };
-
-struct _ffewhere_root_ll_ GTY (())
-  {
-    ffewhereLL_ first;
-    ffewhereLL_ last;
-  };
-
-struct _ffewhere_root_line_
-  {
-    ffewhereLine first;
-    ffewhereLine last;
-    ffewhereLineNumber none;
-  };
-
-/* Static objects accessed by functions in this module. */
-
-static GTY (()) struct _ffewhere_root_ll_ *ffewhere_root_ll_;
-static struct _ffewhere_root_line_ ffewhere_root_line_;
-
-/* Static functions (internal). */
-
-static ffewhereLL_ ffewhere_ll_lookup_ (ffewhereLineNumber ln);
-
-/* Internal macros. */
-
-
-/* Look up line-to-line object from absolute line num.  */
-
-static ffewhereLL_
-ffewhere_ll_lookup_ (ffewhereLineNumber ln)
-{
-  ffewhereLL_ ll;
-
-  if (ln == 0)
-    return ffewhere_root_ll_->first;
-
-  for (ll = ffewhere_root_ll_->last;
-       ll != (ffewhereLL_) &ffewhere_root_ll_->first;
-       ll = ll->previous)
-    {
-      if (ll->line_no <= ln)
-	return ll;
-    }
-
-  assert ("no line num" == NULL);
-  return NULL;
-}
-
-/* Create file object.  */
-
-ffewhereFile
-ffewhere_file_new (const char *name, size_t length)
-{
-  ffewhereFile wf;
-  wf = ggc_alloc (offsetof (struct _ffewhere_file_, text) + length + 1);
-  wf->length = length;
-  memcpy (&wf->text[0], name, length);
-  wf->text[length] = '\0';
-
-  return wf;
-}
-
-/* Set file and first line number.
-
-   Pass FALSE if no line number is specified.  */
-
-void
-ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln)
-{
-  ffewhereLL_ ll;
-  ll = ggc_alloc (sizeof (*ll));
-  ll->next = (ffewhereLL_) &ffewhere_root_ll_->first;
-  ll->previous = ffewhere_root_ll_->last;
-  ll->next->previous = ll;
-  ll->previous->next = ll;
-  if (wf == NULL)
-    {
-      if (ll->previous == ll->next)
-	ll->wf = NULL;
-      else
-	ll->wf = ll->previous->wf;
-    }
-  else
-    ll->wf = wf;
-  ll->line_no = ffelex_line_number ();
-  if (have_num)
-    ll->offset = ln;
-  else
-    {
-      if (ll->previous == ll->next)
-	ll->offset = 1;
-      else
-	ll->offset
-	  = ll->line_no - ll->previous->line_no + ll->previous->offset;
-    }
-}
-
-/* Do initializations.  */
-
-void
-ffewhere_init_1 (void)
-{
-  ffewhere_root_line_.first = ffewhere_root_line_.last
-  = (ffewhereLine) &ffewhere_root_line_.first;
-  ffewhere_root_line_.none = 0;
-
-  /* The sentinel is (must be) GGC-allocated.  It is accessed as a
-     struct _ffewhere_ll_/ffewhereLL_ though its type contains just the
-     first two fields (layout-wise).  */
-  ffewhere_root_ll_ = ggc_alloc_cleared (sizeof (struct _ffewhere_ll_));
-  ffewhere_root_ll_->first = ffewhere_root_ll_->last
-    = (ffewhereLL_) &ffewhere_root_ll_->first;
-}
-
-/* Return the textual content of the line.  */
-
-char *
-ffewhere_line_content (ffewhereLine wl)
-{
-  assert (wl != NULL);
-  return wl->content;
-}
-
-/* Look up file object from line object.  */
-
-ffewhereFile
-ffewhere_line_file (ffewhereLine wl)
-{
-  ffewhereLL_ ll;
-
-  assert (wl != NULL);
-  ll = ffewhere_ll_lookup_ (wl->line_num);
-  return ll->wf;
-}
-
-/* Lookup file object from line object, calc line#.  */
-
-ffewhereLineNumber
-ffewhere_line_filelinenum (ffewhereLine wl)
-{
-  ffewhereLL_ ll;
-
-  assert (wl != NULL);
-  ll = ffewhere_ll_lookup_ (wl->line_num);
-  return wl->line_num + ll->offset - ll->line_no;
-}
-
-/* Decrement use count for line, deallocate if no uses left.  */
-
-void
-ffewhere_line_kill (ffewhereLine wl)
-{
-#if 0
-  if (!ffewhere_line_is_unknown (wl))
-    fprintf (dmpout, "; ffewhere_line_kill %" ffewhereLineNumber_f "u, uses=%"
-	     ffewhereUses_f_ "u\n",
-	     wl->line_num, wl->uses);
-#endif
-  assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
-  if (!ffewhere_line_is_unknown (wl) && (--wl->uses == 0))
-    {
-      wl->previous->next = wl->next;
-      wl->next->previous = wl->previous;
-      malloc_kill_ks (ffe_pool_file (), wl,
-		      offsetof (struct _ffewhere_line_, content)
-		      + wl->length + 1);
-    }
-}
-
-/* Make a new line or increment use count of existing one.
-
-   Find out where line object is, if anywhere.	If in lexer, it might also
-   be at the end of the list of lines, else put it on the end of the list.
-   Then, if in the list of lines, increment the use count and return the
-   line object.	 Else, make an empty line object (no line) and return
-   that.  */
-
-ffewhereLine
-ffewhere_line_new (ffewhereLineNumber ln)
-{
-  ffewhereLine wl = ffewhere_root_line_.last;
-
-  /* If this is the lexer's current line, see if it is already at the end of
-     the list, and if not, make it and return it. */
-
-  if (((ln == 0)		/* Presumably asking for EOF pointer. */
-       || (wl->line_num != ln))
-      && (ffelex_line_number () == ln))
-    {
-#if 0
-      fprintf (dmpout,
-	       "; ffewhere_line_new %" ffewhereLineNumber_f "u, lexer\n",
-	       ln);
-#endif
-      wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
-			  offsetof (struct _ffewhere_line_, content)
-			  + (size_t) ffelex_line_length () + 1);
-      wl->next = (ffewhereLine) &ffewhere_root_line_;
-      wl->previous = ffewhere_root_line_.last;
-      wl->previous->next = wl;
-      wl->next->previous = wl;
-      wl->line_num = ln;
-      wl->uses = 1;
-      wl->length = ffelex_line_length ();
-      strcpy (wl->content, ffelex_line ());
-      return wl;
-    }
-
-  /* See if line is on list already. */
-
-  while (wl->line_num > ln)
-    wl = wl->previous;
-
-  /* If line is there, increment its use count and return. */
-
-  if (wl->line_num == ln)
-    {
-#if 0
-      fprintf (dmpout, "; ffewhere_line_new %" ffewhereLineNumber_f "u, uses=%"
-	       ffewhereUses_f_ "u\n", ln,
-	       wl->uses);
-#endif
-      wl->uses++;
-      return wl;
-    }
-
-  /* Else, make a new one with a blank line (since we've obviously lost it,
-     which should never happen) and return it. */
-
-  fprintf (stderr,
-	   "(Cannot resurrect line %lu for error reporting purposes.)\n",
-	   ln);
-
-  wl = malloc_new_ks (ffe_pool_file (), "FFEWHERE line",
-		      offsetof (struct _ffewhere_line_, content)
-		      + 1);
-  wl->next = (ffewhereLine) &ffewhere_root_line_;
-  wl->previous = ffewhere_root_line_.last;
-  wl->previous->next = wl;
-  wl->next->previous = wl;
-  wl->line_num = ln;
-  wl->uses = 1;
-  wl->length = 0;
-  *(wl->content) = '\0';
-  return wl;
-}
-
-/* Increment use count of line, as in a copy.  */
-
-ffewhereLine
-ffewhere_line_use (ffewhereLine wl)
-{
-#if 0
-  fprintf (dmpout, "; ffewhere_line_use %" ffewhereLineNumber_f "u, uses=%" ffewhereUses_f_
-	   "u\n", wl->line_num, wl->uses);
-#endif
-  assert (ffewhere_line_is_unknown (wl) || (wl->uses != 0));
-  if (!ffewhere_line_is_unknown (wl))
-    ++wl->uses;
-  return wl;
-}
-
-/* Set an ffewhere object based on a track index.
-
-   Determines the absolute line and column number of a character at a given
-   index into an ffewhereTrack array.  wr* is the reference position, wt is
-   the tracking information, and i is the index desired.  wo* is set to wr*
-   plus the continual offsets described by wt[0...i-1], or unknown if any of
-   the continual offsets are not known.	 */
-
-void
-ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
-			 ffewhereLine wrl, ffewhereColumn wrc,
-			 ffewhereTrack wt, ffewhereIndex i)
-{
-  ffewhereLineNumber ln;
-  ffewhereColumnNumber cn;
-  ffewhereIndex j;
-  ffewhereIndex k;
-
-  if ((i == 0) || (i >= FFEWHERE_indexMAX))
-    {
-      *wol = ffewhere_line_use (wrl);
-      *woc = ffewhere_column_use (wrc);
-    }
-  else
-    {
-      ln = ffewhere_line_number (wrl);
-      cn = ffewhere_column_number (wrc);
-      for (j = 0, k = 0; j < i; ++j, k += 2)
-	{
-	  if ((wt[k] == FFEWHERE_indexUNKNOWN)
-	      || (wt[k + 1] == FFEWHERE_indexUNKNOWN))
-	    {
-	      *wol = ffewhere_line_unknown ();
-	      *woc = ffewhere_column_unknown ();
-	      return;
-	    }
-	  if (wt[k] == 0)
-	    cn += wt[k + 1] + 1;
-	  else
-	    {
-	      ln += wt[k];
-	      cn = wt[k + 1] + 1;
-	    }
-	}
-      if (ln == ffewhere_line_number (wrl))
-	{			/* Already have the line object, just use it
-				   directly. */
-	  *wol = ffewhere_line_use (wrl);
-	}
-      else			/* Must search for the line object. */
-	*wol = ffewhere_line_new (ln);
-      *woc = ffewhere_column_new (cn);
-    }
-}
-
-/* Build next tracking index.
-
-   Set wt[i-1] continual offset so that it offsets from w* to (ln,cn).	Update
-   w* to contain (ln,cn).  DO NOT call this routine if i >= FFEWHERE_indexMAX
-   or i == 0.  */
-
-void
-ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
-		ffewhereIndex i, ffewhereLineNumber ln,
-		ffewhereColumnNumber cn)
-{
-  unsigned int lo;
-  unsigned int co;
-
-  if ((ffewhere_line_is_unknown (*wl))
-      || (ffewhere_column_is_unknown (*wc))
-      || ((lo = ln - ffewhere_line_number (*wl)) >= FFEWHERE_indexUNKNOWN))
-    {
-      wt[i * 2 - 2] = wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
-      ffewhere_line_kill (*wl);
-      ffewhere_column_kill (*wc);
-      *wl = FFEWHERE_lineUNKNOWN;
-      *wc = FFEWHERE_columnUNKNOWN;
-    }
-  else if (lo == 0)
-    {
-      wt[i * 2 - 2] = 0;
-      if ((co = cn - ffewhere_column_number (*wc)) > FFEWHERE_indexUNKNOWN)
-	{
-	  wt[i * 2 - 1] = FFEWHERE_indexUNKNOWN;
-	  ffewhere_line_kill (*wl);
-	  ffewhere_column_kill (*wc);
-	  *wl = FFEWHERE_lineUNKNOWN;
-	  *wc = FFEWHERE_columnUNKNOWN;
-	}
-      else
-	{
-	  wt[i * 2 - 1] = co - 1;
-	  ffewhere_column_kill (*wc);
-	  *wc = ffewhere_column_use (ffewhere_column_new (cn));
-	}
-    }
-  else
-    {
-      wt[i * 2 - 2] = lo;
-      wt[i * 2 - 1] = cn - 1;
-      ffewhere_line_kill (*wl);
-      ffewhere_column_kill (*wc);
-      *wl = ffewhere_line_use (ffewhere_line_new (ln));
-      *wc = ffewhere_column_use (ffewhere_column_new (cn));
-    }
-}
-
-/* Clear tracking index for internally created track.
-
-   Set the tracking information to indicate that the tracking is at its
-   simplest (no spaces or newlines within the tracking).  This means set
-   everything to zero in the current implementation.  Length is the total
-   length of the token; length must be 2 or greater, since length-1 tracking
-   characters are set.	*/
-
-void
-ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length)
-{
-  ffewhereIndex i;
-
-  if (length > FFEWHERE_indexMAX)
-    length = FFEWHERE_indexMAX;
-
-  for (i = 1; i < length; ++i)
-    wt[i * 2 - 2] = wt[i * 2 - 1] = 0;
-}
-
-/* Copy tracking index from one place to another.
-
-   Copy tracking information from swt[start] to dwt[0] and so on, presumably
-   after an ffewhere_set_from_track call.  Length is the total
-   length of the token; length must be 2 or greater, since length-1 tracking
-   characters are set.	*/
-
-void
-ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt, ffewhereIndex start,
-		     ffewhereIndex length)
-{
-  ffewhereIndex i;
-  ffewhereIndex copy;
-
-  if (length > FFEWHERE_indexMAX)
-    length = FFEWHERE_indexMAX;
-
-  if (length + start > FFEWHERE_indexMAX)
-    copy = FFEWHERE_indexMAX - start;
-  else
-    copy = length;
-
-  for (i = 1; i < copy; ++i)
-    {
-      dwt[i * 2 - 2] = swt[(i + start) * 2 - 2];
-      dwt[i * 2 - 1] = swt[(i + start) * 2 - 1];
-    }
-
-  for (; i < length; ++i)
-    {
-      dwt[i * 2 - 2] = 0;
-      dwt[i * 2 - 1] = 0;
-    }
-}
-
-/* Kill tracking data.
-
-   Kill all the tracking information by killing incremented lines from the
-   first line number.  */
-
-void
-ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc UNUSED,
-		     ffewhereTrack wt, ffewhereIndex length)
-{
-  ffewhereLineNumber ln;
-  unsigned int lo;
-  ffewhereIndex i;
-
-  ln = ffewhere_line_number (wrl);
-
-  if (length > FFEWHERE_indexMAX)
-    length = FFEWHERE_indexMAX;
-
-  for (i = 0; i < length - 1; ++i)
-    {
-      if ((lo = wt[i * 2]) == FFEWHERE_indexUNKNOWN)
-	break;
-      else if (lo != 0)
-	{
-	  ln += lo;
-	  wrl = ffewhere_line_new (ln);
-	  ffewhere_line_kill (wrl);
-	}
-    }
-}
-
-#include "gt-f-where.h"
diff --git a/gcc/f/where.h b/gcc/f/where.h
deleted file mode 100644
index cce7b2a..0000000
--- a/gcc/f/where.h
+++ /dev/null
@@ -1,136 +0,0 @@
-/* where.h -- Public #include File (module.h template V1.0)
-   Copyright (C) 1995, 2002 Free Software Foundation, Inc.
-   Contributed by James Craig Burley.
-
-This file is part of GNU Fortran.
-
-GNU Fortran 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.
-
-GNU Fortran 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 GNU Fortran; see the file COPYING.  If not, write to
-the Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA.
-
-   Owning Modules:
-      where.c
-
-   Modifications:
-*/
-
-/* Allow multiple inclusion to work. */
-
-#ifndef GCC_F_WHERE_H
-#define GCC_F_WHERE_H
-
-/* Simple definitions and enumerations. */
-
-#define FFEWHERE_columnMAX UCHAR_MAX
-#define FFEWHERE_columnUNKNOWN 0
-#define FFEWHERE_indexMAX 36
-#define FFEWHERE_indexUNKNOWN UCHAR_MAX
-#define FFEWHERE_lineMAX ULONG_MAX
-#define FFEWHERE_lineUNKNOWN (&ffewhere_unknown_line_)
-#define FFEWHERE_filenameUNKNOWN ("(input file)")
-
-/* Typedefs. */
-
-typedef unsigned char ffewhereColumnNumber;	/* Change FFEWHERE_columnMAX
-						   too. */
-#define ffewhereColumnNumber_f ""
-typedef unsigned char ffewhereColumn;
-typedef struct _ffewhere_file_ *ffewhereFile;
-typedef unsigned short ffewhereLength_;
-#define ffewhereLength_f_ ""
-typedef unsigned long ffewhereLineNumber;	/* Change FFEWHERE_lineMAX
-						   too. */
-#define ffewhereLineNumber_f "l"
-typedef struct _ffewhere_line_ *ffewhereLine;
-typedef unsigned char ffewhereIndex;
-#define ffewhereIndex_f ""
-typedef ffewhereIndex ffewhereTrack[FFEWHERE_indexMAX * 2 - 2];
-typedef unsigned int ffewhereUses_;
-#define ffewhereUses_f_ ""
-
-/* Include files needed by this one. */
-
-#include "top.h"
-
-/* Structure definitions. */
-
-struct _ffewhere_file_ GTY (())
-  {
-    size_t length;
-    char text[1];
-  };
-
-struct _ffewhere_line_
-  {
-    ffewhereLine next;
-    ffewhereLine previous;
-    ffewhereLineNumber line_num;
-    ffewhereUses_ uses;
-    ffewhereLength_ length;
-    char content[1];
-  };
-
-/* Global objects accessed by users of this module. */
-
-extern struct _ffewhere_line_ ffewhere_unknown_line_;
-
-/* Declare functions with prototypes. */
-
-ffewhereFile ffewhere_file_new (const char *name, size_t length);
-void ffewhere_file_set (ffewhereFile wf, bool have_num, ffewhereLineNumber ln);
-void ffewhere_init_1 (void);
-char *ffewhere_line_content (ffewhereLine l);
-ffewhereFile ffewhere_line_file (ffewhereLine l);
-ffewhereLineNumber ffewhere_line_filelinenum (ffewhereLine l);
-void ffewhere_line_kill (ffewhereLine l);
-ffewhereLine ffewhere_line_new (ffewhereLineNumber ln);
-ffewhereLine ffewhere_line_use (ffewhereLine wl);
-void ffewhere_set_from_track (ffewhereLine *wol, ffewhereColumn *woc,
-		     ffewhereLine wrl, ffewhereColumn wrc, ffewhereTrack wt,
-			      ffewhereIndex i);
-void ffewhere_track (ffewhereLine *wl, ffewhereColumn *wc, ffewhereTrack wt,
-	   ffewhereIndex i, ffewhereLineNumber ln, ffewhereColumnNumber cn);
-void ffewhere_track_clear (ffewhereTrack wt, ffewhereIndex length);
-void ffewhere_track_copy (ffewhereTrack dwt, ffewhereTrack swt,
-			  ffewhereIndex start, ffewhereIndex length);
-void ffewhere_track_kill (ffewhereLine wrl, ffewhereColumn wrc, ffewhereTrack wt,
-			  ffewhereIndex length);
-
-/* Define macros. */
-
-#define ffewhere_column_is_unknown(c) (c == FFEWHERE_columnUNKNOWN)
-#define ffewhere_column_kill(c) ((void) 0)
-#define ffewhere_column_new(cn) (cn)
-#define ffewhere_column_number(c) (c)
-#define ffewhere_column_unknown() (FFEWHERE_columnUNKNOWN)
-#define ffewhere_column_use(c) (c)
-#define ffewhere_file_name(f) ((f)->text)
-#define ffewhere_file_namelen(f) ((f)->length)
-#define ffewhere_init_0()
-#define ffewhere_init_2()
-#define ffewhere_init_3()
-#define ffewhere_init_4()
-#define ffewhere_line_filename(l) (ffewhere_line_file(l)->text)
-#define ffewhere_line_is_unknown(l) (l == FFEWHERE_lineUNKNOWN)
-#define ffewhere_line_number(l) ((l)->line_num)
-#define ffewhere_line_unknown() (FFEWHERE_lineUNKNOWN)
-#define ffewhere_terminate_0()
-#define ffewhere_terminate_1()
-#define ffewhere_terminate_2()
-#define ffewhere_terminate_3()
-#define ffewhere_terminate_4()
-
-/* End of #include file. */
-
-#endif /* ! GCC_F_EHERE_H */